1#!/usr/bin/perl -w 2# mv-demo.pl --- 3# Last modify Time-stamp: <Ye Wenbin 2007-10-07 21:48:03> 4# Version: v 0.0 2007/09/26 13:31:45 5# Author: Ye Wenbin <wenbinye@gmail.com> 6 7use strict; 8use warnings; 9 10use FindBin qw/$Bin/; 11use lib "$Bin/../blib/arch"; 12use lib "$Bin/../blib/lib"; 13 14use Gtk2 '-init'; 15use Glib qw(TRUE FALSE); 16use Goo::Canvas; 17 18my $window = create_window(); 19Gtk2->main; 20 21#{{{ Main window 22sub create_window { 23 my $window = Gtk2::Window->new('toplevel'); 24 $window->signal_connect('delete_event' => sub { Gtk2->main_quit; }); 25 $window->set_default_size(640, 600); 26 $window->show; 27 28 my $notebook = Gtk2::Notebook->new; 29 $window->add($notebook); 30 $notebook->show; 31 32 foreach my $pkg ( 33 "Primitives", 34 "Arrowhead", 35 "Fifteen", 36 "Reparent", 37 "Scalability", 38 "Grabs", 39 "Events", 40 "Paths", 41 "Focus", 42 "Animation", 43 "Clipping", 44 ) { 45 $notebook->append_page( 46 $pkg->create_canvas(), 47 Gtk2::Label->new($pkg) 48 ); 49 } 50 return $window; 51} 52#}}} 53 54#{{{ Primitives 55package Primitives; 56use Gtk2; 57use Glib qw(TRUE FALSE); 58use constant { 59 VERTICES => 10, 60 RADIUS => 60, 61 SCALE => 7, 62}; 63use Math::Trig qw/pi/; 64 65sub create_canvas { 66 my $pkg = shift; 67 my $vbox = Gtk2::VBox->new; 68 my $group; 69 my ($hbox, $w, $swin, $canvas, $adj); 70 my $bg_color = Gtk2::Gdk::Color->new(50000, 50000, 65535); 71 72 $vbox->set_border_width(4); 73 $vbox->show; 74 $w = Gtk2::Label->new("Drag an item with button 1. Click button 2 on an item to lower it, or button 3 to raise it."); 75 $vbox->pack_start($w, FALSE, FALSE, 0); 76 $w->show; 77 78 $hbox = Gtk2::HBox->new(FALSE, 4); 79 $vbox->pack_start($hbox, FALSE, FALSE, 0); 80 $hbox->show; 81 # Create the canvas 82 $canvas = Goo::Canvas->new; 83 $canvas->modify_base('normal', $bg_color); 84 $canvas->set_bounds(0, 0, 604, 454); 85 86 ###### Frist Row 87 # Zoom 88 $w = Gtk2::Label->new("Zoom:"); 89 $hbox->pack_start($w, FALSE, FALSE, 0); 90 $w->show; 91 92 $adj = Gtk2::Adjustment->new(1, 0.05, 100, 0.05, 0.5, 0.5); 93 $w = Gtk2::SpinButton->new($adj, 0, 2); 94 $adj->signal_connect("value-changed", \&zoom_changed, $canvas); 95 $w->set_size_request(50, -1); 96 $hbox->pack_start($w, FALSE, FALSE, 0); 97 $w->show; 98 # Center 99 $w = Gtk2::CheckButton->new_with_label("Center scroll region"); 100 $hbox->pack_start($w, FALSE, FALSE, 0); 101 # $w->show; 102 $w->signal_connect("toggled", \¢er_toggled, $canvas); 103 # Move Ellipse 104 $w = Gtk2::Button->new_with_label('Move Ellipse'); 105 $hbox->pack_start($w, FALSE, FALSE, 0); 106 $w->show; 107 $w->signal_connect("clicked", \&move_ellipse_clicked, $canvas); 108 # Animate Ellipse 109 $w = Gtk2::Button->new_with_label('Animate Ellipse'); 110 $hbox->pack_start($w, FALSE, FALSE, 0); 111 $w->show; 112 $w->signal_connect("clicked", \&animate_ellipse_clicked, $canvas); 113 # Stop Animation 114 $w = Gtk2::Button->new_with_label('Stop Animation'); 115 $hbox->pack_start($w, FALSE, FALSE, 0); 116 $w->show; 117 $w->signal_connect("clicked", \&stop_animation_clicked, $canvas); 118 # Create PDF 119 $w = Gtk2::Button->new_with_label('Write PDF'); 120 $hbox->pack_start($w, FALSE, FALSE, 0); 121 $w->show; 122 $w->signal_connect("clicked", \&write_pdf_clicked, $canvas); 123 ##### Start anothor Row 124 $hbox = Gtk2::HBox->new(FALSE, 4); 125 $vbox->pack_start($hbox, FALSE, FALSE, 0); 126 $hbox->show; 127 # Scroll to 128 $w = Gtk2::Label->new('Scroll to:'); 129 $hbox->pack_start($w, FALSE, FALSE, 0); 130 $w->show; 131 132 $w = Gtk2::Button->new_with_label('50,50'); 133 $hbox->pack_start($w, FALSE, FALSE, 0); 134 $w->show; 135 $w->signal_connect("clicked", \&scroll_to_50_50_clicked, $canvas); 136 $w = Gtk2::Button->new_with_label('250,250'); 137 $hbox->pack_start($w, FALSE, FALSE, 0); 138 $w->show; 139 $w->signal_connect("clicked", \&scroll_to_250_250_clicked, $canvas); 140 $w = Gtk2::Button->new_with_label('500,500'); 141 $hbox->pack_start($w, FALSE, FALSE, 0); 142 $w->show; 143 $w->signal_connect("clicked", \&scroll_to_500_500_clicked, $canvas); 144 # Scroll anchor 145 $w = Gtk2::Label->new('Anchor:'); 146 $hbox->pack_start($w, FALSE, FALSE, 0); 147 $w->show; 148 149 foreach my $anchor( 'NW', 'N', 'NE', 'W', 'SW', 'S', 'SE' ) { 150 $w = Gtk2::RadioButton->new_with_label($group, $anchor); 151 $group = $w; 152 $hbox->pack_start($w, FALSE, FALSE, 0); 153 $w->show; 154 $w->signal_connect('toggled', \&anchor_toggled, $canvas); 155 $w->{anchor} = lc($anchor); 156 } 157 # Layout the stuff 158 $swin = Gtk2::ScrolledWindow->new(); 159 $swin->show; 160 $vbox->pack_start($swin, TRUE, TRUE, 0); 161 $canvas->show; 162 $swin->add($canvas); 163 $canvas->signal_connect('item-created', \&on_item_created); 164 my $model = Goo::Canvas::GroupModel->new; 165 create_model($model); 166 $canvas->set_root_item_model($model); 167 if ( 0 ) { 168 $canvas->signal_connect_after('key_press_event', \&key_press); 169 $canvas->can_focus(TRUE); 170 $canvas->grab_focus; 171 } 172 return $vbox; 173} 174 175sub create_model { 176 my $root = shift; 177 setup_divisions($root); 178 setup_rectangles($root); 179 setup_ellipses($root); 180 setup_lines($root); 181 setup_polygons($root); 182 setup_texts($root); 183 setup_images($root); 184 setup_invisible_texts($root); 185} 186 187sub setup_divisions { 188 my $root = shift; 189 my ($group, $item); 190 $group = Goo::Canvas::GroupModel->new($root); 191 $group->{'skip-signal-connection'} = TRUE; 192 $group->translate(2, 2); 193 $item = Goo::Canvas::RectModel->new( 194 $group, 0, 0, 600, 450, 195 'line-width' => 4 196 ); 197 $item->{'skip-signal-connection'} = TRUE; 198 $item = Goo::Canvas::PolylineModel->new_line( 199 $group, 0, 150, 600, 150, 200 'line-width' => 4, 201 ); 202 $item->{'skip-signal-connection'} = TRUE; 203 $item = Goo::Canvas::PolylineModel->new_line( 204 $group, 0, 300, 600, 300, 205 'line-width' => 4, 206 ); 207 $item->{'skip-signal-connection'} = TRUE; 208 $item = Goo::Canvas::PolylineModel->new_line( 209 $group, 200, 0, 200, 450, 210 'line-width' => 4, 211 ); 212 $item->{'skip-signal-connection'} = TRUE; 213 $item = Goo::Canvas::PolylineModel->new_line( 214 $group, 400, 0, 400, 450, 215 'line-width' => 4, 216 ); 217 $item->{'skip-signal-connection'} = TRUE; 218 setup_heading ($group, "Rectangles", 0); 219 setup_heading ($group, "Ellipses", 1); 220 setup_heading ($group, "Texts", 2); 221 setup_heading ($group, "Images", 3); 222 setup_heading ($group, "Lines", 4); 223 setup_heading ($group, "Polygons", 7); 224} 225 226sub setup_heading { 227 my ($root, $text, $pos) = @_; 228 my $x = ($pos%3)*200 + 100; 229 my $y = (int($pos/3))*150 + 5; 230 my $item = Goo::Canvas::TextModel->new( 231 $root, $text, $x, $y, -1, 'n', 232 'font' => 'Sans 12' 233 ); 234 $item->skew_y(30, $x, $y); 235} 236 237sub setup_rectangles { 238 my $root = shift; 239 my ($item, $pattern); 240 my @stipple_data = ( 241 0, 0, 0, 255, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 255 242 ); 243 $item = Goo::Canvas::RectModel->new( 244 $root, 20, 30, 50, 30, 245 'stroke-color' => 'red', 246 'line-width' => 8, 247 ); 248 $pattern = create_stipple('mediumseagreen', \@stipple_data); 249 $item = Goo::Canvas::RectModel->new( 250 $root, 90, 40, 90, 60, 251 'fill-pattern' => $pattern, 252 'stroke-color' => 'black', 253 'line-width' => 4, 254 ); 255 $item = Goo::Canvas::RectModel->new( 256 $root, 10, 80, 70, 60, 257 'fill-color' => 'steelblue', 258 ); 259 $item = Goo::Canvas::RectModel->new( 260 $root, 20, 90, 70, 60, 261 'fill-color-rgba' => 0x3cb37180, 262 'stroke-color' => 'blue', 263 'line-width' => 2, 264 ); 265 $item = Goo::Canvas::RectModel->new( 266 $root, 110, 80, 50, 30, 267 'radius-x' => 20, 268 'radius-y' => 10, 269 'stroke-color' => 'yellow', 270 'fill-color-rgba' => 0x3cb3f180, 271 ); 272 $item = Goo::Canvas::RectModel->new( 273 $root, 30, 20, 50, 30, 274 'fill-color' => 'yellow', 275 ); 276} 277 278sub create_stipple { 279 our @stipples; 280 my($color_name, $stipple_data) = @_; 281 my $color = Gtk2::Gdk::Color->parse($color_name); 282 $stipple_data->[2] = $stipple_data->[14] = $color->red >> 8; 283 $stipple_data->[1] = $stipple_data->[13] = $color->green >> 8; 284 $stipple_data->[0] = $stipple_data->[12] = $color->blue >> 8; 285 my $stipple_str = join('', map {chr} @$stipple_data); 286 push @stipples, \$stipple_str; # make $stipple_str refcnt increase 287 my $surface = Cairo::ImageSurface->create_for_data( 288 $stipple_str, 'argb32', 289 2, 2, 8 290 ); 291 my $pattern = Cairo::SurfacePattern->create($surface); 292 $pattern->set_extend('repeat'); 293 return Goo::Cairo::Pattern->new($pattern); 294} 295 296sub setup_ellipses { 297 my $root = shift; 298 my @stipple_data = ( 299 0, 0, 0, 255, 0, 0, 0, 0, 300 0, 0, 0, 0, 0, 0, 0, 255 301 ); 302 my $ellipse1 = Goo::Canvas::EllipseModel->new( 303 $root, 245, 45, 25, 15, 304 'stroke-color' => 'goldenrod', 305 'line-width' => 8 306 ); 307 my $ellipse2 = Goo::Canvas::EllipseModel->new( 308 $root, 335, 70, 45, 30, 309 'fill-color' => 'wheat', 310 'stroke-color' => 'midnightblue', 311 'line-width' => 4, 312 'title' => 'An ellipse' 313 ); 314 $root->{ellipse} = $ellipse2; 315 my $pattern = create_stipple('cadetblue', \@stipple_data); 316 my $ellipse3 = Goo::Canvas::EllipseModel->new( 317 $root, 245, 110, 35, 30, 318 'fill-pattern' => $pattern, 319 'stroke-color' => 'black', 320 'line-width' => 1, 321 ); 322} 323 324sub setup_lines { 325 my $root = shift; 326 my $line; 327 328 polish_diamond($root); 329 make_hilbert($root); 330 $line = Goo::Canvas::PolylineModel->new( 331 $root, FALSE, 332 [ 340, 170, 333 340, 230, 334 390, 230, 335 390, 170 ], 336 'stroke-color' => 'midnightblue', 337 'line-width' => 3, 338 'start-arrow' => TRUE, 339 'end-arrow' => TRUE, 340 'arrow-tip-length' => 3, 341 'arrow-length' => 4, 342 'arrow-width' => 3.5 343 ); 344 $line = Goo::Canvas::PolylineModel->new( 345 $root, FALSE, 346 [ 356, 180, 347 374, 220, ], 348 'stroke-color' => 'blue', 349 'line-width' => 1, 350 'start-arrow' => TRUE, 351 'end-arrow' => TRUE, 352 'arrow-tip-length' => 5, 353 'arrow-length' => 6, 354 'arrow-width' => 6, 355 ); 356 $line = Goo::Canvas::PolylineModel->new( 357 $root, FALSE, 358 [356, 220, 359 374, 180,], 360 'stroke-color' => 'blue', 361 'line-width' => 1, 362 'start-arrow' => TRUE, 363 'end-arrow' => TRUE, 364 'arrow-tip-length' => 5, 365 'arrow-length' => 6, 366 'arrow-width' => 6, 367 ); 368 $line = Goo::Canvas::PolylineModel->new($root, FALSE, []); 369 $line = Goo::Canvas::PolylineModel->new( 370 $root, FALSE, 371 [356, 220], 372 'start-arrow' => TRUE, 373 'end-arrow' => TRUE, 374 ); 375} 376 377sub polish_diamond { 378 my $root = shift; 379 my $item; 380 my ($a, $x1, $y1, $x2, $y2); 381 my $group = Goo::Canvas::GroupModel->new( 382 $root, 383 'line-width' => 1, 384 'line-cap' => 'round' 385 ); 386 $group->translate(270, 230); 387 for my $i ( 0..VERTICES ) { 388 $a = 2*pi*$i/VERTICES; 389 $x1 = RADIUS * cos($a); 390 $y1 = RADIUS * sin($a); 391 for my $j ( $i+1..VERTICES ) { 392 $a = 2*pi*$j/VERTICES; 393 $x2 = RADIUS * cos($a); 394 $y2 = RADIUS * sin($a); 395 $item = Goo::Canvas::PolylineModel->new_line( 396 $group, $x1, $y1, $x2, $y2 397 ); 398 $item->{'skip-signal-connection'} = TRUE; 399 } 400 } 401} 402 403sub make_hilbert { 404 my $root = shift; 405 my $hilbert = "urdrrulurulldluuruluurdrurddldrrruluurdrurddldrddlulldrdldrrurd"; 406 my @stipple_data = ( 407 0, 0, 0, 255, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 255 408 ); 409 my $pattern = create_stipple('red', \@stipple_data); 410 my @points = ( [340, 290] ); 411 my $pp = $points[0]; 412 foreach ( 0..length($hilbert)-1 ) { 413 my @p; 414 my $c = substr($hilbert, $_, 1); 415 if ( $c eq 'u' ) { 416 $p[0] = $pp->[0]; 417 $p[1] = $pp->[1] - SCALE; 418 } 419 elsif ( $c eq 'd' ) { 420 $p[0] = $pp->[0]; 421 $p[1] = $pp->[1] + SCALE; 422 } 423 elsif ( $c eq 'l' ) { 424 $p[0] = $pp->[0] - SCALE; 425 $p[1] = $pp->[1]; 426 } 427 elsif ( $c eq 'r' ) { 428 $p[0] = $pp->[0] + SCALE; 429 $p[1] = $pp->[1]; 430 } 431 push @points, \@p; 432 $pp = \@p; 433 } 434 my $item = Goo::Canvas::PolylineModel->new( 435 $root, FALSE, [map {@{$_}} @points], 436 'line-width' => 4, 437 'stroke-pattern' => $pattern, 438 'line-cap' => 'square', 439 'line-join' => 'miter' 440 ); 441} 442 443sub setup_polygons { 444 my $root = shift; 445 my $line; 446 my @stipple_data = ( 447 0, 0, 0, 255, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 255 448 ); 449 my @points = ( 450 210, 320, 451 210, 380, 452 260, 350 453 ); 454 my $pattern = create_stipple('blue', \@stipple_data); 455 $line = Goo::Canvas::PolylineModel->new( 456 $root, TRUE, \@points, 457 'line-width' => 1, 458 'fill-pattern' => $pattern, 459 'stroke-color' => 'black' 460 ); 461 @points = ( 462 270.0, 330.0, 463 270.0, 430.0, 464 390.0, 430.0, 465 390.0, 330.0, 466 310.0, 330.0, 467 310.0, 390.0, 468 350.0, 390.0, 469 350.0, 370.0, 470 330.0, 370.0, 471 330.0, 350.0, 472 370.0, 350.0, 473 370.0, 410.0, 474 290.0, 410.0, 475 290.0, 330.0, 476 ); 477 $line = Goo::Canvas::PolylineModel->new( 478 $root, TRUE, \@points, 479 'fill-color' => 'tan', 480 'stroke-color' => 'black', 481 'line-width' => 3, 482 ); 483} 484 485sub setup_texts { 486 my $root = shift; 487 my @stipple_data = ( 488 0, 0, 0, 255, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 255 489 ); 490 my $pattern = create_stipple('blue', \@stipple_data); 491 my $item; 492 $item = Goo::Canvas::TextModel->new( 493 make_anchor($root, 420, 20), 494 'Anchor NW', 495 0, 0, -1, 'nw', 496 'font' => 'Sans Bold 24', 497 'fill-pattern' => $pattern, 498 ); 499 500 $item = Goo::Canvas::TextModel->new( 501 make_anchor($root, 470, 75), 502 "Anchor center\nJustify center\nMultiline text\nb8bit text ÅÄÖåäö", 503 0, 0, -1, 'center', 504 "font" => "monospace bold 14", 505 "alignment" => 'center', 506 "fill-color" => "firebrick", 507 ); 508 509 $item = Goo::Canvas::TextModel->new( 510 make_anchor($root, 590, 140), 511"Clipped text\nClipped text\nClipped text\nClipped text\nClipped text\nClipped text", 512 0, 0, -1, 'se', 513 'font' =>'Sans 12', 514 'fill-color' => 'darkgreen' 515 ); 516 517 $item = Goo::Canvas::TextModel->new( 518 make_anchor($root, 420, 240), 519 "This is a very long paragraph that will need to be wrapped over several lines so we can see what happens to line-breaking as the view is zoomed in and out.", 520 0, 0, 180, 'w', 521 'font' => 'Sans 12', 522 'fill-color' => 'goldenrod' 523 ); 524} 525 526sub make_anchor { 527 my($root, $x, $y) = @_; 528 my $group = Goo::Canvas::GroupModel->new($root); 529 my $transform = Goo::Cairo::Matrix->new( 530 Cairo::Matrix->init(0.8, 0.2, -0.3, 0.5, $x, $y ), 531 ); 532 my $item; 533 534 $group->translate($x, $y); 535 $group->set( 'transform' => $transform ); 536 $item = Goo::Canvas::RectModel->new( 537 $group, -2.5, -2.5, 4, 4, 538 'line-width' => 1, 539 ); 540 return $group; 541} 542 543sub setup_images { 544 my $root = shift; 545 my ($im, $image); 546 use Data::Dumper qw(Dumper); 547 $im = Gtk2::Gdk::Pixbuf->new_from_file("$FindBin::Bin/toroid.png"); 548 if ( $im ) { 549 my $w = $im->get_width; 550 my $h = $im->get_height; 551 $image = Goo::Canvas::ImageModel->new( 552 $root, $im, 100-$w/2, 225-$h/2, 553 'width' => $w, 554 'height' => $h 555 ); 556 } else { 557 warn "Could not foundhe toroid.png sample file\n"; 558 } 559 plant_flower ($root, 20.0, 170.0, 'nw'); 560 plant_flower ($root, 180.0, 170.0, 'ne'); 561 plant_flower ($root, 20.0, 280.0, 'sw'); 562 plant_flower ($root, 180.0, 280.0, 'se'); 563} 564 565sub plant_flower { 566 my ($root, $x, $y, $anchor) = @_; 567 my $surface = Cairo::ImageSurface->create_from_png("$FindBin::Bin/flower.png"); 568 my $w = $surface->get_width; 569 my $h = $surface->get_height; 570 my $pattern = Cairo::SurfacePattern->create($surface); 571 my $image = Goo::Canvas::ImageModel->new( 572 $root, undef, $x, $y, 573 'pattern' => Goo::Cairo::Pattern->new($pattern), 574 'width' => $w, 575 'height' => $h, 576 ); 577} 578 579sub setup_invisible_texts { 580 my $root = shift; 581 Goo::Canvas::TextModel->new( 582 $root, "Visible above 0.8x", 500, 330, -1, 'center', 583 "visibility" => 'visible_above_threshold', 584 "visibility-threshold" => 0.8, 585 ); 586 Goo::Canvas::RectModel->new( 587 $root, 410.5, 322.5, 180, 15, 588 "line-width" => 1.0, 589 "visibility" => 'visible-above-threshold', 590 "visibility-threshold" => 0.8, 591 ); 592 593 Goo::Canvas::TextModel->new( 594 $root, "Visible above 1.5x", 500, 350, -1, 'center', 595 "visibility" => 'visible-above-threshold', 596 "visibility-threshold" => 1.5, 597 ); 598 Goo::Canvas::RectModel->new( 599 $root, 410.5, 342.5, 180, 15, 600 "line-width" => 1.0, 601 "visibility" => 'visible-above-threshold', 602 "visibility-threshold" => 1.5, 603 ); 604 605 Goo::Canvas::TextModel->new( 606 $root, "Visible above 3.0x", 500, 370, -1, 'center', 607 "visibility" => 'visible-above-threshold', 608 "visibility-threshold" => 3.0, 609 ); 610 Goo::Canvas::RectModel->new( 611 $root, 410.5, 362.5, 180, 15, 612 "line-width" => 1.0, 613 "visibility" => 'visible-above-threshold', 614 "visibility-threshold" => 3.0, 615 ); 616 617 # This should never be seen. 618 Goo::Canvas::TextModel->new( 619 $root, "Always Invisible", 500, 390, -1, 'center', 620 "visibility" => 'invisible', 621 ); 622 Goo::Canvas::RectModel->new( 623 $root, 410.5, 350.5, 180, 15, 624 "line-width" => 1.0, 625 "visibility" => 'invisible', 626 ); 627} 628 629#{{{ Signals 630sub on_item_created { 631 my ($canvas, $item, $model, $data) = @_; 632 if ( ! $model->get_parent ) { 633 $item->signal_connect('button_press_event', \&on_background_button_press); 634 } elsif ( not $model->{'skip-signal-connection'} ) { 635 $item->signal_connect('motion_notify_event', \&on_motion_notify); 636 $item->signal_connect('button_press_event', \&on_button_press); 637 $item->signal_connect('button_release_event', \&on_button_release); 638 } 639} 640 641sub on_motion_notify { 642 my ($item, $target, $ev) = @_; 643 my $model = $item->get_model; 644 if ( $model->{dragging} && $ev->state >= 'button1-mask' ) { 645 $model->translate($ev->x - $model->{drag_x}, 646 $ev->y - $model->{drag_y}); 647 } 648 return TRUE; 649} 650 651sub on_button_press { 652 my ($item, $target, $ev) = @_; 653 my $model = $item->get_model; 654 if ( $ev->button == 1 ) { 655 if ( $ev->state >= 'shift-mask' ) { 656 my $parent = $model->get_parent; 657 $parent->remove_child($parent->find_child($model)); 658 } else { 659 $model->{drag_x} = $ev->x; 660 $model->{drag_y} = $ev->y; 661 my $fleur = Gtk2::Gdk::Cursor->new('fleur'); 662 my $canvas = $item->get_canvas; 663 $canvas->pointer_grab($item, ['pointer-motion-mask', 'button-release-mask'], 664 $fleur, $ev->time); 665 $model->{dragging} = TRUE; 666 } 667 } 668 elsif ( $ev->button == 2 ) { 669 $model->lower; 670 } 671 elsif ( $ev->button == 3 ) { 672 $model->raise; 673 } 674 return TRUE; 675} 676 677sub on_button_release { 678 my ($item, $target, $ev) = @_; 679 my $canvas = $item->get_canvas; 680 $canvas->pointer_ungrab($item, $ev->time); 681 $item->get_model->{dragging} = FALSE; 682 return TRUE; 683} 684 685sub on_background_button_press { 686 return TRUE; 687} 688 689sub zoom_changed { 690 my ($adj, $canvas) = @_; 691 $canvas->set_scale($adj->get_value); 692} 693 694sub center_toggled { 695} 696 697sub anchor_toggled { 698 my ($but, $canvas) = @_; 699 if ( $but->get_active ) { 700 $canvas->set("anchor" => $but->{anchor}); 701 } 702} 703 704sub scroll_to_50_50_clicked { 705 my ($but, $canvas) = @_; 706 $canvas->scroll_to(50, 50); 707} 708 709sub scroll_to_250_250_clicked { 710 my ($but, $canvas) = @_; 711 $canvas->scroll_to(250, 250); 712} 713 714sub scroll_to_500_500_clicked { 715 my ($but, $canvas) = @_; 716 $canvas->scroll_to(500, 500); 717} 718 719sub animate_ellipse_clicked { 720 my ($but, $canvas) = @_; 721 $canvas->get_root_item_model->{ellipse}->animate(100, 100, 1, 90, TRUE, 1000, 40, 'bounce'); 722} 723 724sub stop_animation_clicked { 725 my ($but, $canvas) = @_; 726 $canvas->get_root_item_model->{ellipse}->stop_animation(); 727} 728 729sub move_ellipse_clicked { 730 my ($but, $canvas) = @_; 731 my $ellipse = $canvas->get_root_item_model->{ellipse}; 732 if ( !exists $ellipse->{last_state} ) { 733 $ellipse->{last_state} = 0; 734 } 735 my $last_state = $ellipse->{last_state}; 736 if ( $last_state == 0 ) { 737 $ellipse->set( 738 'center-x' => 300, 739 'center-y' => 70, 740 'radius-x' => 45, 741 'radius-y' => 30, 742 'fill-color' => 'red', 743 'stroke-color' => 'midnightblue', 744 'line-width' => 4, 745 'title' => 'A red ellipse' 746 ); 747 $last_state = 1; 748 } 749 elsif ( $last_state == 1 ) { 750 $ellipse->set( 751 'center-x' => 390, 752 'center-y' => 150, 753 'radius-x' => 45, 754 'radius-y' => 40, 755 'fill-color' => 'brown', 756 'stroke-color' => 'midnightblue', 757 'line-width' => 4, 758 'title' => 'A brown ellipse' 759 ); 760 $last_state = 2; 761 } 762 elsif ( $last_state == 2 ) { 763 $ellipse->set( 764 'center-x' => 0, 765 'center-y' => 0, 766 'radius-y' => 30, 767 ); 768 $ellipse->set_simple_transform(100, 100, 1, 0); 769 $last_state = 3; 770 } 771 elsif ( $last_state == 3 ) { 772 $ellipse->set_simple_transform(200, 200, 2, 0); 773 $last_state = 4; 774 } 775 elsif ( $last_state == 4 ) { 776 $ellipse->set_simple_transform(200, 200, 1, 45); 777 $last_state = 5; 778 } 779 elsif ( $last_state == 5 ) { 780 $ellipse->set_simple_transform(-50, -50, 0.2, 225); 781 $last_state = 6; 782 } 783 else { 784 $ellipse->set( 785 'center-x' => 335, 786 'center-y' => 70, 787 'radius-x' => 45, 788 'radius-y' => 30, 789 'fill-color' => 'purple', 790 'stroke-color' => 'midnightblue', 791 'line-width' => 4, 792 'title' => 'A purple ellipse' 793 ); 794 $last_state = 0; 795 } 796 $ellipse->{last_state} = $last_state; 797 return TRUE; 798} 799sub write_pdf_clicked { 800 my ($but, $canvas) = @_; 801 print "Write PDF...\n"; 802 my $surface = Cairo::PdfSurface->create("demo.pdf", 9*72, 10*72); 803 my $cr = Cairo::Context->create($surface); 804 $cr->translate(20, 130); 805 $canvas->render($cr, undef, 1); 806 $cr->show_page; 807 return TRUE; 808} 809 810#}}} 811#}}} 812 813#{{{ Arrowhead 814package Arrowhead; 815use Gtk2; 816use Glib qw(TRUE FALSE); 817use constant { 818 LEFT => 50.0, 819 RIGHT => 350.0, 820 MIDDLE => 150.0, 821 DEFAULT_WIDTH => 2, 822 DEFAULT_SHAPE_A => 4, 823 DEFAULT_SHAPE_B => 5, 824 DEFAULT_SHAPE_C => 4, 825}; 826 827sub create_canvas { 828 my $pkg = shift; 829 my ($w, $frame, $canvas, $root, $item); 830 my $vbox = Gtk2::VBox->new; 831 $vbox->show; 832 $vbox->set_border_width(4); 833 $w = Gtk2::Label->new( <<EOF ); 834This demo allows you to edit arrowhead shapes. Drag the little boxes 835to change the shape of the line and its arrowhead. You can see the 836arrows at their normal scale on the right hand side of the window. 837EOF 838 $vbox->pack_start($w, FALSE, FALSE, 0); 839 $w->show; 840 $w = Gtk2::Alignment->new(0.5, 0.5, 0, 0); 841 $vbox->pack_start($w, TRUE, TRUE, 0); 842 $w->show; 843 $frame = Gtk2::Frame->new; 844 $frame->set_shadow_type('in'); 845 $w->add($frame); 846 $frame->show; 847 848 $canvas = Goo::Canvas->new; 849 $canvas->set_size_request(500, 350); 850 $canvas->set_bounds(0, 0, 500, 350); 851 $frame->add($canvas); 852 $canvas->show; 853 $canvas->{width} = DEFAULT_WIDTH; 854 $canvas->{shape_a} = DEFAULT_SHAPE_A; 855 $canvas->{shape_b} = DEFAULT_SHAPE_B; 856 $canvas->{shape_c} = DEFAULT_SHAPE_C; 857 $canvas->signal_connect('item-created', \&on_item_created); 858 859 $root = Goo::Canvas::GroupModel->new; 860 $canvas->set_root_item_model($root); 861 # Big arrow 862 $item = Goo::Canvas::PolylineModel->new_line( 863 $root, LEFT, MIDDLE, RIGHT, MIDDLE, 864 'stroke-color' => 'mediumseagreen', 865 'end_arrow' => TRUE, 866 ); 867 $canvas->{big_arrow} = $item; 868 # Arrow outline 869 $item = Goo::Canvas::PolylineModel->new( 870 $root, TRUE, undef, 871 "stroke-color" => 'black', 872 'line-width' => 2, 873 'line-cap' => 'round', 874 'line-join' => 'round' 875 ); 876 $canvas->{outline} = $item; 877 # Drag boxes 878 create_drag_box($canvas, $root, 'width_drag_box'); 879 create_drag_box($canvas, $root, 'shape_a_drag_box'); 880 create_drag_box($canvas, $root, 'shape_b_c_drag_box'); 881 # Dimensions 882 create_dimension ($canvas, $root, "width_arrow", "width_text", 'e'); 883 create_dimension ($canvas, $root, "shape_a_arrow", "shape_a_text", 'n'); 884 create_dimension ($canvas, $root, "shape_b_arrow", "shape_b_text", 'n'); 885 create_dimension ($canvas, $root, "shape_c_arrow", "shape_c_text", 'w'); 886 # Info 887 create_info ($canvas, $root, "width_info", LEFT, 260); 888 create_info ($canvas, $root, "shape_a_info", LEFT, 280); 889 create_info ($canvas, $root, "shape_b_info", LEFT, 300); 890 create_info ($canvas, $root, "shape_c_info", LEFT, 320); 891 # Division line 892 Goo::Canvas::PolylineModel->new_line( 893 $root, RIGHT + 50, 0, RIGHT+ 50, 1000, 894 'fill-color' => 'black', 895 'line-width' => 2 896 ); 897 # Sample arrows 898 create_sample_arrow ($canvas, $root, "sample_1", 899 RIGHT + 100, 30, RIGHT + 100, MIDDLE - 30); 900 create_sample_arrow ($canvas, $root, "sample_2", 901 RIGHT + 70, MIDDLE, RIGHT + 130, MIDDLE); 902 create_sample_arrow ($canvas, $root, "sample_3", 903 RIGHT + 70, MIDDLE + 30, RIGHT + 130, MIDDLE + 120); 904 # Done 905 set_arrow_shape($canvas); 906 return $vbox; 907} 908 909sub set_dimension { 910 my ($canvas, $arrow_name, $text_name, $x1, $y1, $x2, $y2, $tx, $ty, $dim) = @_; 911 my $points = Goo::Canvas::Points->new([$x1, $y1, $x2, $y2]); 912 $canvas->{$arrow_name}->set(points => $points); 913 $canvas->{$text_name}->set(text => sprintf("%.2f", $dim), 914 x => $tx, 915 y => $ty); 916} 917 918sub move_drag_box { 919 my ($item, $x, $y) = @_; 920 $item->set(x => $x-5, 921 y => $y-5); 922} 923 924sub set_arrow_shape { 925 my $canvas = shift; 926 my $width = $canvas->{width}; 927 my $shape_a = $canvas->{shape_a}; 928 my $shape_b = $canvas->{shape_b}; 929 my $shape_c = $canvas->{shape_c}; 930 # Big arrow 931 $canvas->{big_arrow}->set( 932 'line-width' => 10*$width, 933 'arrow-tip-length' => $shape_a, 934 'arrow-length' => $shape_b, 935 'arrow-width' => $shape_c 936 ); 937 # Outline 938 my @points; 939 $points[0] = RIGHT -int(10 *$shape_a*$width); 940 $points[1] = MIDDLE-int(10*$width/2); 941 $points[2] = RIGHT - 10 * $shape_b * $width; 942 $points[3] = MIDDLE - 10 * ($shape_c * $width / 2.0); 943 $points[4] = RIGHT; 944 $points[5] = MIDDLE; 945 $points[6] = RIGHT - 10 * $shape_b * $width; 946 $points[7] = MIDDLE + 10 * ($shape_c * $width / 2.0); 947 $points[8] = RIGHT -int(10 *$shape_a*$width); 948 $points[9] = MIDDLE + 10 * $width / 2; 949 $canvas->{outline}->set( 950 points => Goo::Canvas::Points->new(\@points) 951 ); 952 move_drag_box($canvas->{width_drag_box}, LEFT, MIDDLE-10*$width/2); 953 move_drag_box($canvas->{shape_a_drag_box}, 954 RIGHT-10*$shape_a*$width, MIDDLE); 955 move_drag_box($canvas->{shape_b_c_drag_box}, 956 RIGHT-10*$shape_b*$width, MIDDLE-10*($shape_c*$width/2)); 957 # Dimensions 958 set_dimension($canvas, 'width_arrow', 'width_text', 959 LEFT - 10, 960 MIDDLE - 10 * $width / 2.0, 961 LEFT - 10, 962 MIDDLE + 10 * $width / 2.0, 963 LEFT - 15, 964 MIDDLE, 965 $width); 966 set_dimension ($canvas, "shape_a_arrow", "shape_a_text", 967 RIGHT - 10 * $shape_a * $width, 968 MIDDLE + 10 * ($shape_c * $width / 2.0) + 10, 969 RIGHT, 970 MIDDLE + 10 * ($shape_c * $width / 2.0) + 10, 971 RIGHT - 10 * $shape_a * $width / 2.0, 972 MIDDLE + 10 * ($shape_c * $width / 2.0) + 15, 973 $shape_a); 974 set_dimension ($canvas, "shape_b_arrow", "shape_b_text", 975 RIGHT - 10 * $shape_b * $width, 976 MIDDLE + 10 * ($shape_c * $width / 2.0) + 35, 977 RIGHT, 978 MIDDLE + 10 * ($shape_c * $width / 2.0) + 35, 979 RIGHT - 10 * $shape_b * $width / 2.0, 980 MIDDLE + 10 * ($shape_c * $width / 2.0) + 40, 981 $shape_b); 982 983 set_dimension ($canvas, "shape_c_arrow", "shape_c_text", 984 RIGHT + 10, 985 MIDDLE - 10 * $shape_c * $width / 2.0, 986 RIGHT + 10, 987 MIDDLE + 10 * $shape_c * $width / 2.0, 988 RIGHT + 15, 989 MIDDLE, 990 $shape_c); 991 # Info 992 $canvas->{width_info}->set( 993 text => sprintf("line-width: %.2f", $width) 994 ); 995 $canvas->{shape_a_info}->set( 996 text => sprintf("arrow-tip-length: %.2f (* line-width)", 997 $shape_a) 998 ); 999 $canvas->{shape_b_info}->set( 1000 text => sprintf("arrow-length: %.2f (* line-width)", 1001 $shape_b) 1002 ); 1003 $canvas->{shape_c_info}->set( 1004 text => sprintf("arrow-width: %.2f (* line-width)", 1005 $shape_c) 1006 ); 1007 # Sample arrows 1008 for ( qw/ sample_1 sample_2 sample_3 / ) { 1009 $canvas->{$_}->set( 1010 "line-width" => $width, 1011 "arrow-tip-length" => $shape_a, 1012 "arrow-length" => $shape_b, 1013 "arrow-width" => $shape_c, 1014 ); 1015 } 1016} 1017 1018sub create_dimension { 1019 my ($canvas, $root, $arrow_name, $text_name, $anchor) = @_; 1020 my $item; 1021 $item = Goo::Canvas::PolylineModel->new( 1022 $root, FALSE, undef, 1023 'fill-color' => 'black', 1024 'start-arrow' => TRUE, 1025 'end-arrow' => TRUE, 1026 ); 1027 $canvas->{$arrow_name} = $item; 1028 $item = Goo::Canvas::TextModel->new( 1029 $root, "", 0, 0, -1, $anchor, 1030 'fill-color' => 'black', 1031 'font' => 'Sans 12', 1032 ); 1033 $canvas->{$text_name} = $item; 1034} 1035 1036sub create_info { 1037 my ($canvas, $root, $info_name, $x, $y) = @_; 1038 my $item = Goo::Canvas::TextModel->new( 1039 $root, "", $x, $y, -1, 'nw', 1040 'fill-color' => 'black', 1041 'font' => 'Sans 12', 1042 ); 1043 $canvas->{$info_name} = $item; 1044} 1045 1046sub create_sample_arrow { 1047 my ($canvas, $root, $sample_name, $x1, $y1, $x2, $y2) = @_; 1048 my $item = Goo::Canvas::PolylineModel->new_line( 1049 $root, $x1, $y1, $x2, $y2, 1050 'start-arrow' => TRUE, 1051 'end-arrow' => TRUE, 1052 ); 1053 $canvas->{$sample_name} = $item; 1054} 1055 1056sub on_enter_notify { 1057 my ($item, $target, $ev) = @_; 1058 my $model = $target->get_model; 1059 $model->set('fill-color' => 'red'); 1060 return TRUE; 1061} 1062 1063sub on_leave_notify { 1064 my ($item, $target, $ev) = @_; 1065 my $model= $target->get_model; 1066 $model->set('fill-color' => 'black'); 1067 return TRUE; 1068} 1069 1070sub on_button_press { 1071 my ($item, $target, $ev) = @_; 1072 my $fleur = Gtk2::Gdk::Cursor->new('fleur'); 1073 $item->get_canvas->pointer_grab( 1074 $item, ['pointer-motion-mask', 'button-release-mask'], 1075 $fleur, $ev->time); 1076 return TRUE; 1077} 1078 1079sub on_button_release { 1080 my ($item, $target, $ev) = @_; 1081 $item->get_canvas->pointer_ungrab( 1082 $item, $ev->time 1083 ); 1084 return TRUE; 1085} 1086 1087sub on_motion { 1088 my ($item, $target, $ev)= @_; 1089 my $canvas = $item->get_canvas; 1090 my $model = $target->get_model; 1091 my ($x, $y, $width, $shape_a, $shape_b, $shape_c); 1092 my $change = FALSE; 1093 unless ( $ev->state >= 'button1-mask' ) { 1094 return FALSE; 1095 } 1096 if ( $model == $canvas->{width_drag_box} ) { 1097 $y = $ev->y; 1098 $width = (MIDDLE-$y)/5; 1099 if ( $width < 0) { 1100 return FALSE; 1101 } 1102 $canvas->{width} = $width; 1103 set_arrow_shape($canvas); 1104 } 1105 elsif ( $model == $canvas->{shape_a_drag_box} ) { 1106 $x = $ev->x; 1107 $width = $canvas->{width}; 1108 $shape_a = (RIGHT-$x)/10/$width; 1109 if ( ($shape_a < 0) || ($shape_a>30) ) { 1110 return FALSE; 1111 } 1112 $canvas->{shape_a} =$shape_a; 1113 set_arrow_shape($canvas); 1114 } 1115 elsif ( $model == $canvas->{shape_b_c_drag_box} ) { 1116 $x = $ev->x; 1117 $width = $canvas->{width}; 1118 $shape_b = (RIGHT-$x)/10/$width; 1119 if ( ($shape_b >= 0) && ($shape_b <=30) ) { 1120 $canvas->{shape_b} = $shape_b; 1121 $change = TRUE; 1122 } 1123 $y = $ev->y; 1124 $shape_c = (MIDDLE-$y) * 2/10/$width; 1125 if ( $shape_c >= 0 ) { 1126 $canvas->{shape_c} = $shape_c; 1127 $change = TRUE; 1128 } 1129 if ( $change ) { 1130 set_arrow_shape($canvas); 1131 } 1132 } 1133 return TRUE; 1134} 1135 1136sub create_drag_box { 1137 my ($canvas, $root, $box_name) = @_; 1138 my $item = Goo::Canvas::RectModel->new( 1139 $root, 0, 0, 10, 10, 1140 'fill-color' => 'black', 1141 'stroke-color' => 'black', 1142 'line-width' => 1, 1143 ); 1144 $canvas->{$box_name} = $item; 1145} 1146 1147sub on_item_created { 1148 my ($canvas, $item, $model) = @_; 1149 if ( $model->isa("Goo::Canvas::RectModel")) { 1150 $item->signal_connect( 1151 'enter_notify_event' => \&on_enter_notify 1152 ); 1153 $item->signal_connect( 1154 'leave_notify_event' => \&on_leave_notify, 1155 ); 1156 $item->signal_connect( 1157 'button_press_event' => \&on_button_press 1158 ); 1159 $item->signal_connect( 1160 'button_release_event' => \&on_button_release 1161 ); 1162 $item->signal_connect( 1163 'motion_notify_event' => \&on_motion 1164 ); 1165 } 1166} 1167 1168#}}} 1169 1170#{{{ Fifteen 1171package Fifteen; 1172use Gtk2; 1173use Glib qw(TRUE FALSE); 1174 1175use constant { 1176 PIECE_SIZE => 50, 1177 SCRAMBLE_MOVES => 256, 1178}; 1179 1180sub create_canvas { 1181 my $pkg = shift; 1182 my $vbox = Gtk2::VBox->new; 1183 my ($alignment, $frame, $canvas, $root, $button); 1184 my ($x, $y, @board); 1185 1186 $vbox->set_border_width(4); 1187 $vbox->show; 1188 1189 $alignment = Gtk2::Alignment->new(0.5, 0.5, 0, 0); 1190 $vbox->pack_start($alignment, TRUE, TRUE, 0); 1191 $alignment->show; 1192 1193 $frame = Gtk2::Frame->new(); 1194 $frame->set_shadow_type('in'); 1195 $alignment->add($frame); 1196 $frame->show; 1197 1198 # Create the canvas and board 1199 $canvas = Goo::Canvas->new; 1200 $root = Goo::Canvas::GroupModel->new; 1201 $canvas->set_root_item_model($root); 1202 $canvas->signal_connect('item-created', \&on_item_created); 1203 $canvas->set_size_request( PIECE_SIZE * 4 + 1, 1204 PIECE_SIZE * 4 + 1); 1205 $canvas->set_bounds(0, 0, PIECE_SIZE * 4+1, PIECE_SIZE * 4 + 1); 1206 $frame->add($canvas); 1207 $canvas->show; 1208 1209 foreach my $i( 0..14 ) { 1210 $x = $i % 4; 1211 $y = int($i / 4); 1212 my $item = Goo::Canvas::GroupModel->new($root); 1213 $item->translate($x * PIECE_SIZE, $y * PIECE_SIZE); 1214 my $rect = Goo::Canvas::RectModel->new( 1215 $item, 0, 0, PIECE_SIZE, PIECE_SIZE, 1216 'fill-color' => get_piece_color($i), 1217 'stroke-color' => 'black', 1218 'line-width' => 1 1219 ); 1220 my $text = Goo::Canvas::TextModel->new( 1221 $item, $i+1, PIECE_SIZE/2, PIECE_SIZE/2, -1, 'center', 1222 'font' => 'Sans bold 24', 1223 'fill-color' => 'black' 1224 ); 1225 $item->{text} = $text; 1226 $item->{piece_num} = $i; 1227 $item->{piece_pos} = $i; 1228 push @board, $item; 1229 } 1230 push @board, undef; 1231 $canvas->{board} = \@board; 1232 $button = Gtk2::Button->new("Scramble"); 1233 $vbox->pack_start($button, FALSE, FALSE, 0); 1234 $button->signal_connect('clicked', \&scramble, $canvas); 1235 $button->show; 1236 return $vbox; 1237} 1238 1239sub get_piece_color { 1240 use integer; 1241 my $i = shift; 1242 my $x = $i % 4; 1243 my $y = $i / 4; 1244 my $r = (( 4- $x) * 255) /4; 1245 my $g = (( 4- $y) * 255) /4; 1246 my $b = 128; 1247 return sprintf("#%02x%02x%02x", $r, $g, $b); 1248} 1249 1250sub piece_enter_notify { 1251 my ($item, $target, $ev)= @_; 1252 my $model = $item->get_model; 1253 $model->{text}->set( 1254 'fill-color' => 'white' 1255 ); 1256 return FALSE; 1257} 1258 1259sub piece_leave_notify { 1260 my ($item, $target, $ev)= @_; 1261 my $model = $item->get_model; 1262 $model->{text}->set( 1263 'fill-color' => 'black' 1264 ); 1265 return FALSE; 1266} 1267 1268sub piece_button_press { 1269 my ($item, $target, $event, $data) = @_; 1270 my ($num, $pos, $text, $x, $y, $move, $dx, $dy, $newpos); 1271 1272 my $canvas = $item->get_canvas; 1273 my $model = $item->get_model; 1274 my $board = $canvas->{board}; 1275 $num = $model->{piece_num}; 1276 $pos = $model->{piece_pos}; 1277 $text = $model->{text}; 1278 $x = $pos % 4; 1279 $y = int($pos / 4); 1280 $move = TRUE; 1281 if ( $y>0 && !$board->[($y-1)*4+$x] ) { 1282 $dx = 0; 1283 $dy = -1; 1284 $y--; 1285 } 1286 elsif ( $y<3 && !$board->[($y+1)*4+$x] ) { 1287 $dx = 0; 1288 $dy = 1; 1289 $y++; 1290 } 1291 elsif ( $x>0 && !$board->[$y*4+$x-1] ) { 1292 $dx = -1; 1293 $dy = 0; 1294 $x--; 1295 } 1296 elsif ( $x<3 && !$board->[$y*4+$x+1] ) { 1297 $dx = 1; 1298 $dy = 0; 1299 $x++; 1300 } 1301 else { 1302 $move = FALSE; 1303 } 1304 if ( $move ) { 1305 $newpos = $y*4+$x; 1306 $board->[$pos] = undef; 1307 $board->[$newpos] = $model; 1308 $model->{piece_pos} = $newpos; 1309 $model->translate($dx*PIECE_SIZE, $dy*PIECE_SIZE); 1310 test_win($board, $canvas); 1311 } 1312 return FALSE; 1313} 1314 1315sub test_win { 1316 my ($board, $canvas) = @_; 1317 foreach ( 0..14 ) { 1318 if ( !$board->[$_] || $board->[$_]{piece_num} != $_ ) { 1319 return; 1320 } 1321 } 1322 if ( 1 ) { 1323 my $item = ($board->[0] || $board->[1]); 1324 my $dia = Gtk2::MessageDialog->new( 1325 $canvas->get_toplevel, 'destroy-with-parent', 1326 'info', 'ok', 1327 'You stud, you win!', 1328 ); 1329 $dia->show; 1330 $dia->signal_connect( 'response' => sub { $dia->destroy; } ); 1331 } 1332 return TRUE; 1333} 1334 1335sub on_item_created { 1336 my ($canvas, $item, $model) = @_; 1337 if ( $model->get_parent && $model->isa("Goo::Canvas::GroupModel") ) { 1338 $item->signal_connect( 1339 'enter_notify_event' => \&piece_enter_notify 1340 ); 1341 $item->signal_connect( 1342 'leave_notify_event' => \&piece_leave_notify, 1343 ); 1344 $item->signal_connect( 1345 'button-press-event' => \&piece_button_press, 1346 ); 1347 } 1348} 1349 1350sub scramble { 1351 my ($but, $canvas) = @_; 1352 my $board = $canvas->{board}; 1353 my ($x, $y, $dir, $oldpos); 1354 my $pos = 0; 1355 foreach ( @$board ) { 1356 last unless $_; 1357 $pos++; 1358 } 1359 for ( 0..SCRAMBLE_MOVES ) { 1360 my $done = 0; 1361 $x = $y = 0; 1362 while ( !$done ) { 1363 $dir = int(rand(4)); 1364 $done = 1; 1365 if ( $dir == 0 && $pos > 3 ) { 1366 $y = -1; 1367 } elsif ( $dir==1 && $pos < 12 ) { 1368 $y = 1; 1369 } elsif ( $dir == 2 && ($pos%4) != 0 ) { 1370 $x = -1; 1371 } 1372 elsif ( $dir == 3 && ($pos %4) != 3 ) { 1373 $x = 1; 1374 } 1375 else { 1376 $done = 0; 1377 } 1378 } 1379 $oldpos = $pos + $y*4 + $x; 1380 $board->[$pos] = $board->[$oldpos]; 1381 $board->[$oldpos] = undef; 1382 $board->[$pos]->{piece_pos} = $pos; 1383 $board->[$pos]->translate(-$x*PIECE_SIZE, -$y*PIECE_SIZE); 1384 $pos = $oldpos; 1385 } 1386} 1387#}}} 1388 1389#{{{ Reparent 1390package Reparent; 1391use Gtk2; 1392use Glib qw(TRUE FALSE); 1393 1394sub create_canvas { 1395 my $pkg = shift; 1396 my ($w, $alignment, $frame, $canvas, $root, $parent1, $parent2, $item, $group); 1397 my $vbox = Gtk2::VBox->new; 1398 $vbox->show; 1399 $vbox->set_border_width(4); 1400 # Instructions 1401 $w = Gtk2::Label->new("Reparent test: click on the items to switch them between parents"); 1402 $vbox->pack_start($w, FALSE, FALSE, 0); 1403 $w->show; 1404 # Frame and canvas 1405 $alignment = Gtk2::Alignment->new(0.5, 0.5, 0, 0); 1406 $vbox->pack_start($alignment, FALSE, FALSE, 0); 1407 $alignment->show; 1408 $frame = Gtk2::Frame->new(); 1409 $frame->set_shadow_type('in'); 1410 $alignment->add($frame); 1411 $frame->show; 1412 $canvas = Goo::Canvas->new; 1413 $canvas->show; 1414 $canvas->signal_connect('item-created', \&on_item_created); 1415 1416 $root = Goo::Canvas::GroupModel->new; 1417 $canvas->set_size_request( 400, 200); 1418 $canvas->set_bounds( 0, 0, 300, 200); 1419 $frame->add($canvas); 1420 # First parent and box 1421 $parent1 = Goo::Canvas::GroupModel->new($root); 1422 Goo::Canvas::RectModel->new( 1423 $parent1, 0, 0, 200, 200, 1424 'fill-color' => 'tan' 1425 ); 1426 # Second parent and box 1427 $parent2 = Goo::Canvas::GroupModel->new($root); 1428 $parent2->translate(200, 0); 1429 Goo::Canvas::RectModel->new( 1430 $parent2, 0, 0, 200, 200, 1431 'fill-color' => '#204060' 1432 ); 1433 # Big circle to be reparented 1434 $item = Goo::Canvas::EllipseModel->new( 1435 $parent1, 100, 100, 90, 90, 1436 'stroke-color' => 'black', 1437 'fill-color' => 'mediumseagreen', 1438 'line-width' => 3, 1439 ); 1440 $item->{parent1} = $parent1; 1441 $item->{parent2} = $parent2; 1442 # A group to be reparented 1443 $group = Goo::Canvas::GroupModel->new($parent2); 1444 $group->{parent1} = $parent1; 1445 $group->{parent2} = $parent2; 1446 $group->translate(100, 100); 1447 Goo::Canvas::EllipseModel->new( 1448 $group, 0, 0, 50, 50, 1449 'stroke-color' => 'black', 1450 'fill-color' => 'wheat', 1451 'line-width' => 3, 1452 ); 1453 Goo::Canvas::EllipseModel->new( 1454 $group, 0, 0, 25, 25, 1455 'fill-color' => 'steelblue', 1456 ); 1457 $canvas->set_root_item_model($root); 1458 return $vbox; 1459} 1460 1461sub on_item_created { 1462 my ($canvas, $item, $model) = @_; 1463 if ( $model->{parent1} ) { 1464 $item->signal_connect( 1465 'button-press-event' => \&on_button_press 1466 ); 1467 } 1468} 1469 1470sub on_button_press { 1471 my ($item, $target, $ev) = @_; 1472 if ( $ev->button != 1 || $ev->type ne 'button-press' ) { 1473 return FALSE; 1474 } 1475 my $model = $item->get_model; 1476 my $parent1 = $model->{parent1}; 1477 my $parent2 = $model->{parent2}; 1478 my $parent = $model->get_parent; 1479 my $child_num = $parent->find_child($model); 1480 $parent->remove_child($child_num); 1481 if ( $parent == $parent1 ) { 1482 $parent2->add_child($model, -1); 1483 } 1484 else { 1485 $parent1->add_child($model, -1); 1486 } 1487 return TRUE; 1488} 1489 1490#}}} 1491 1492#{{{ Scalability 1493package Scalability; 1494use Gtk2; 1495use Glib qw(TRUE FALSE); 1496use constant { 1497 N_COLS => 5, 1498 N_ROWS => 20, 1499 PADDING => 10, 1500}; 1501 1502sub create_canvas { 1503 my $pkg = shift; 1504 my $vbox = Gtk2::VBox->new; 1505 my ($table, $frame, $canvas, $root, $width, $height, $pixbuf, 1506 $swin, $item); 1507 my $use_image = 1; 1508 $vbox->show; 1509 $vbox->set_border_width(4); 1510 $table = Gtk2::Table->new(2, 2, FALSE); 1511 $table->set_row_spacings(4); 1512 $table->set_col_spacings(4); 1513 $vbox->pack_start($table, TRUE, TRUE, 0); 1514 $table->show; 1515 $frame = Gtk2::Frame->new(); 1516 $frame->set_shadow_type('in'); 1517 $table->attach($frame, 0,1, 0,1, 1518 ['expand', 'fill', 'shrink'], 1519 ['expand', 'fill', 'shrink'], 1520 0, 0); 1521 $frame->show; 1522 # Create the canvas and board 1523 $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file("$FindBin::Bin/toroid.png"); 1524 if ( $use_image ) { 1525 $width = $pixbuf->get_width + 3; 1526 $height = $pixbuf->get_height + 1; 1527 } 1528 else { 1529 $width = 37; 1530 $height = 19; 1531 } 1532 $canvas = Goo::Canvas->new; 1533 $root = Goo::Canvas::GroupModel->new; 1534 $canvas->set_root_item_model($root); 1535 $canvas->set_size_request( 600, 450); 1536 $canvas->set_bounds( 0, 0, N_COLS*($width+PADDING), N_ROWS*($height+PADDING)); 1537 $canvas->show; 1538 $swin = Gtk2::ScrolledWindow->new(); 1539 $swin->show; 1540 $frame->add($swin); 1541 $swin->add($canvas); 1542 for my $i( 0..N_COLS-1 ) { 1543 for my $j ( 0..N_ROWS-1 ) { 1544 if ( $use_image ) { 1545 $item = Goo::Canvas::ImageModel->new( 1546 $root, $pixbuf, $i*($width+PADDING), $j*($height+PADDING), 1547 ); 1548 } 1549 else { 1550 $item = Goo::Canvas::RectModel->new( 1551 $root, $i*($width+PADDING), $j*($height+PADDING), 1552 $width, $height, 1553 'fill-color' => (($i+$j)%2 ? 'mediumseagreen' : 'steelblue'), 1554 ); 1555 } 1556 } 1557 } 1558 1559 return $vbox; 1560} 1561#}}} 1562 1563#{{{ Grabs 1564package Grabs; 1565use Gtk2; 1566use Glib qw(TRUE FALSE); 1567 1568sub create_canvas { 1569 my $pkg = shift; 1570 my ($w); 1571 my $table = Gtk2::Table->new(5, 2, FALSE); 1572 $table->set_border_width(12); 1573 $table->set_row_spacings(12); 1574 $table->set_col_spacings(12); 1575 $table->show; 1576 $w = Gtk2::Label->new(<<INS); 1577Move the mouse over the widgets and canvas items on the right to see what events they receive. 1578Click buttons to start explicit or implicit pointer grabs and see what events they receive now. 1579(They should all receive the same events.) 1580INS 1581 $table->attach($w, 0,2, 0,1, [],[],0,0); 1582 $w->show; 1583 # Drawing area with explicit grabs. 1584 create_fixed ($table, 1, 1585 "Widget with Explicit Grabs:", 1586 "widget-explicit"); 1587 1588 # Drawing area with implicit grabs. 1589 create_fixed ($table, 2, 1590 "Widget with Implicit Grabs:", 1591 "widget-implicit"); 1592 1593 # Canvas with explicit grabs. 1594 _create_canvas ($table, 3, 1595 "Canvas with Explicit Grabs:", 1596 "canvas-explicit"); 1597 1598 # Canvas with implicit grabs. 1599 _create_canvas ($table, 4, 1600 "Canvas with Implicit Grabs:", 1601 "canvas-implicit"); 1602 1603 return $table; 1604} 1605 1606sub create_fixed { 1607 my ($table, $row, $text, $id) = @_; 1608 my ($label, $fixed, $drawing_area, $view_id); 1609 $label = Gtk2::Label->new($text); 1610 $table->attach($label, 0, 1, $row, $row+1, [], [], 0, 0); 1611 $label->show; 1612 $fixed = Gtk2::Fixed->new; 1613 $fixed->set_has_window(TRUE); 1614 $fixed->set_events( 1615 ['exposure_mask', 'button_press_mask', 1616 'button_release_mask', 'pointer_motion_mask', 1617 'pointer_motion_hint_mask', 'key_press_mask', 1618 'key_release_mask', 'enter_notify_mask', 1619 'leave_notify_mask', 'focus_change_mask'] 1620 ); 1621 $fixed->set_size_request(200, 100); 1622 $table->attach($fixed, 1, 2, $row, $row+1, [], [], 0, 0); 1623 $fixed->show; 1624 $view_id = "$id-background"; 1625 $fixed->signal_connect( 1626 'expose_event', \&on_widget_expose, $view_id 1627 ); 1628 $fixed->signal_connect( "enter_notify_event", 1629 \&on_widget_enter_notify, $view_id); 1630 $fixed->signal_connect( "leave_notify_event", 1631 \&on_widget_leave_notify, $view_id); 1632 $fixed->signal_connect( "motion_notify_event", 1633 \&on_widget_motion_notify, $view_id); 1634 $fixed->signal_connect( "button_press_event", 1635 \&on_widget_button_press, $view_id); 1636 $fixed->signal_connect( "button_release_event", 1637 \&on_widget_button_release, $view_id); 1638 # Left 1639 my $pos = 20; 1640 for ( 'left', 'right' ) { 1641 $drawing_area = Gtk2::DrawingArea->new; 1642 $drawing_area->set_events( 1643 ['exposure_mask', 'button_press_mask', 1644 'button_release_mask', 'pointer_motion_mask', 1645 'pointer_motion_hint_mask', 'key_press_mask', 1646 'key_release_mask', 'enter_notify_mask', 1647 'leave_notify_mask', 'focus_change_mask'] 1648 ); 1649 $drawing_area->set_size_request(60, 60); 1650 $fixed->put($drawing_area, $pos, 20); 1651 $pos += 100; 1652 $drawing_area->show; 1653 $view_id = "$id-$_"; 1654 $drawing_area->signal_connect( "enter_notify_event", 1655 \&on_widget_enter_notify, $view_id); 1656 $drawing_area->signal_connect( "leave_notify_event", 1657 \&on_widget_leave_notify, $view_id); 1658 $drawing_area->signal_connect( "motion_notify_event", 1659 \&on_widget_motion_notify, $view_id); 1660 $drawing_area->signal_connect( "button_press_event", 1661 \&on_widget_button_press, $view_id); 1662 $drawing_area->signal_connect( "button_release_event", 1663 \&on_widget_button_release, $view_id); 1664 } 1665} 1666 1667sub _create_canvas { 1668 my ($table, $row, $text, $id) = @_; 1669 my ($label, $canvas, $root, $rect); 1670 $label = Gtk2::Label->new($text); 1671 $table->attach($label, 0, 1, $row, $row+1, [], [], 0, 0); 1672 $label->show; 1673 $canvas = Goo::Canvas->new; 1674 $root = Goo::Canvas::GroupModel->new; 1675 $canvas->set_root_item_model($root); 1676 $canvas->signal_connect('item-created', \&on_item_created); 1677 $canvas->set_size_request(200, 100); 1678 $canvas->set_bounds(0, 0, 200, 100); 1679 $table->attach($canvas, 1, 2, $row, $row+1, [], [], 0, 0); 1680 $canvas->show; 1681 $rect = Goo::Canvas::RectModel->new( 1682 $root, 0, 0, 200, 100, 1683 'stroke-pattern' => undef, 1684 'fill-color' => 'yellow', 1685 ); 1686 $rect->{id} = "$id-yellow"; 1687 $rect = Goo::Canvas::RectModel->new( 1688 $root, 20, 20, 60, 60, 1689 'stroke-pattern' => undef, 1690 'fill-color' => 'blue', 1691 ); 1692 $rect->{id} = $id.'-blue'; 1693 $rect = Goo::Canvas::RectModel->new( 1694 $root, 120, 20, 60, 60, 1695 'stroke-pattern' => undef, 1696 'fill-color' => 'red', 1697 ); 1698 $rect->{id} = $id.'-red'; 1699} 1700 1701sub on_item_created { 1702 my ($canvas, $item, $model) = @_; 1703 if ( $model->isa("Goo::Canvas::RectModel")) { 1704 $item->signal_connect( "enter_notify_event", 1705 \&on_enter_notify); 1706 $item->signal_connect( "leave_notify_event", 1707 \&on_leave_notify); 1708 $item->signal_connect( "motion_notify_event", 1709 \&on_motion_notify); 1710 $item->signal_connect( "button_press_event", 1711 \&on_button_press); 1712 $item->signal_connect( "button_release_event", 1713 \&on_button_release); 1714 } 1715} 1716# FIXME: the box is not showed 1717sub on_widget_expose { 1718 my ($widget, $ev, $id) = @_; 1719 print "$id received 'expose' signal\n"; 1720 $widget->style->paint_box( 1721 $widget->window, 'normal','in',$ev->area, $widget, undef, 1722 0, 0, $widget->allocation->width, $widget->allocation->height 1723 ); 1724 return FALSE; 1725} 1726 1727sub on_widget_enter_notify { 1728 my ($widget, $ev, $id) = @_; 1729 print "$id received 'enter-notify' signal\n"; 1730 return TRUE; 1731} 1732 1733sub on_widget_leave_notify { 1734 my ($widget, $ev, $id) = @_; 1735 print "$id received 'leave-notify' signal\n"; 1736 return TRUE; 1737} 1738 1739sub on_widget_motion_notify { 1740 my ($widget, $ev, $id) = @_; 1741 print "$id received 'motion-notify' signal(window: ", 1742 sprintf("0x%x", $ev->window->get_pointer), ")\n"; 1743 if ( $ev->is_hint ) { 1744 $ev->window->get_pointer(); 1745 } 1746 return TRUE; 1747} 1748 1749sub on_widget_button_press { 1750 my ($widget, $ev, $id) = @_; 1751 print "$id received 'button-press' signal\n"; 1752 if ( $id =~ /explicit/ ) { 1753 my $mask = [ 1754 'button_press_mask', 'button_release_mask', 1755 'pointer_motion_mask', 'pointer_motion_hint_mask', 1756 'enter_notify_mask', 'leave_notify_mask', 1757 ]; 1758 my $staus = $widget->window->pointer_grab(FALSE, $mask, FALSE, undef, $ev->time); 1759 if ( $staus eq 'success' ) { 1760 print "grabbed pointer\n"; 1761 } else { 1762 print "pointer grab failed\n"; 1763 } 1764 } 1765 return TRUE; 1766} 1767 1768sub on_widget_button_release { 1769 my ($widget, $ev, $id) = @_; 1770 print "$id received 'button-release' signal\n"; 1771 if ( $id =~ /explicit/ ) { 1772 my $display = $widget->get_display; 1773 $display->pointer_ungrab($ev->time); 1774 print "released pointer grab\n"; 1775 } 1776 return TRUE; 1777} 1778 1779sub on_enter_notify { 1780 my ($item, $target, $ev) = @_; 1781 my $model = $target->get_model; 1782 print "$model->{id} received 'enter-notify' signal\n"; 1783 return FALSE; 1784} 1785sub on_leave_notify { 1786 my ($item, $target, $ev) = @_; 1787 my $model = $target->get_model; 1788 print "$model->{id} received 'leave-notify' signal\n"; 1789 return FALSE; 1790} 1791 1792sub on_motion_notify { 1793 my ($item, $target, $ev) = @_; 1794 my $model = $target->get_model; 1795 print "$model->{id} received 'motion-notify' signal\n"; 1796 return FALSE; 1797} 1798 1799sub on_button_press { 1800 my ($item, $target, $ev) = @_; 1801 my $model = $item->get_model; 1802 print "$model->{id} received 'button-press' signal\n"; 1803 if ( $model->{id} =~ /explicit/ ) { 1804 my $mask = [ 1805 'button_press_mask', 'button_release_mask', 1806 'pointer_motion_mask', 'pointer_motion_hint_mask', 1807 'enter_notify_mask', 'leave_notify_mask', 1808 ]; 1809 my $canvas = $item->get_canvas; 1810 my $staus = $canvas->pointer_grab( $item, $mask, undef, $ev->time); 1811 if ( $staus eq 'success' ) { 1812 print "grabbed pointer\n"; 1813 } else { 1814 print "pointer grab failed\n"; 1815 } 1816 } 1817 return FALSE; 1818} 1819 1820sub on_button_release { 1821 my ($item, $target, $ev) = @_; 1822 my $model = $item->get_model; 1823 print "$model->{id} received 'button-released' signal\n"; 1824 if ( $model->{id} =~ /explicit/ ) { 1825 my $canvas = $item->get_canvas; 1826 $canvas->pointer_ungrab($item, $ev->time); 1827 print "released pointer grab\n"; 1828 } 1829 return FALSE; 1830} 1831 1832#}}} 1833 1834#{{{ Events 1835package Events; 1836use Gtk2; 1837use Glib qw(TRUE FALSE); 1838 1839sub create_canvas { 1840 my $pkg = shift; 1841 my $vbox = Gtk2::VBox->new; 1842 my ($alignment, $frame, $label, $canvas); 1843 1844 $vbox->show; 1845 $vbox->set_border_width(4); 1846 # Instructions 1847 $label = Gtk2::Label->new(<<INS); 1848Move the mouse over the items to check they receive the right motion events. 1849The first 2 items in each group are 1) invisible and 2) visible but unpainted. 1850INS 1851 $label->show; 1852 $vbox->pack_start($label, FALSE, FALSE, 0); 1853 # Frame and canvas 1854 $alignment = Gtk2::Alignment->new(0.5, 0.5, 0, 0); 1855 $vbox->pack_start($alignment, FALSE, FALSE, 0); 1856 $alignment->show; 1857 $frame = Gtk2::Frame->new(); 1858 $frame->set_shadow_type('in'); 1859 $alignment->add($frame); 1860 $frame->show; 1861 $canvas = Goo::Canvas->new; 1862 my $root = Goo::Canvas::GroupModel->new; 1863 $canvas->signal_connect('item-created', \&on_item_created); 1864 $canvas->set_root_item_model($root); 1865 $canvas->set_size_request(600, 450); 1866 $canvas->set_bounds(0, 0, 600, 450); 1867 $frame->add($canvas); 1868 $canvas->show; 1869 create_events_area($canvas, 0, 'none', 'none'); 1870 create_events_area($canvas, 1, 'visible-painted', 'visible-painted'); 1871 create_events_area($canvas, 2, 'visible-fill', 'visible-fill'); 1872 create_events_area($canvas, 3, 'visible-stroke', 'visible-stroke'); 1873 create_events_area($canvas, 4, 'visible', 'visible'); 1874 create_events_area($canvas, 5, 'painted', 'painted'); 1875 create_events_area($canvas, 6, 'fill', 'fill'); 1876 create_events_area($canvas, 7, 'stroke', 'stroke'); 1877 create_events_area($canvas, 8, 'all', 'all'); 1878 return $vbox; 1879} 1880 1881sub create_events_area { 1882 my ($canvas, $area_num, $pointer_events, $label) = @_; 1883 my $row = int($area_num/3); 1884 my $col = $area_num%3; 1885 my $x = $col * 200; 1886 my $y = $row * 150; 1887 my $root = $canvas->get_root_item_model; 1888 my $dash = Goo::Canvas::LineDash->new([5, 5]); 1889 my $rect; 1890 1891 # Create invisible item 1892 $rect = Goo::Canvas::RectModel->new( 1893 $root, $x+45, $y+35, 30, 30, 1894 'fill-color' => 'red', 1895 'visibility' => 'invisible', 1896 'line-width' => 5, 1897 'pointer_events' => $pointer_events 1898 ); 1899 $rect->{id} = $label . ' invisible'; 1900 # Display a thin rect around it to indicate it is there 1901 $rect = Goo::Canvas::RectModel->new( 1902 $root, $x+42.5, $y+32.5, 36, 36, 1903 'line-dash' => $dash, 1904 'line-width' => 1, 1905 'stroke-color' => 'gray', 1906 ); 1907 # Create unpainted item. 1908 $rect = Goo::Canvas::RectModel->new( 1909 $root, $x+85, $y+35, 30, 30, 1910 'stroke-pattern' => undef, 1911 'line-width' => 5, 1912 'pointer_events' => $pointer_events 1913 ); 1914 $rect->{id} = $label . ' unpainted'; 1915 # Display a thin rect around it to indicate it is there 1916 $rect = Goo::Canvas::RectModel->new( 1917 $root, $x+82.5, $y+32.5, 36, 36, 1918 'line-dash' => $dash, 1919 'line-width' => 1, 1920 'stroke-color' => 'gray', 1921 ); 1922 # Create stroked item 1923 $rect = Goo::Canvas::RectModel->new( 1924 $root, $x+125, $y+35, 30, 30, 1925 'line-width' => 5, 1926 'pointer_events' => $pointer_events 1927 ); 1928 $rect->{id} = $label . ' stroked'; 1929 # Create filled item 1930 $rect = Goo::Canvas::RectModel->new( 1931 $root, $x+60, $y+75, 30, 30, 1932 'fill-color' => 'red', 1933 'stroke-pattern' => undef, 1934 'line-width' => 5, 1935 'pointer_events' => $pointer_events 1936 ); 1937 $rect->{id} = $label . ' filled'; 1938 # Create filled & filled item 1939 $rect = Goo::Canvas::RectModel->new( 1940 $root, $x+100, $y+75, 30, 30, 1941 'fill-color' => 'red', 1942 'line-width' => 5, 1943 'pointer_events' => $pointer_events 1944 ); 1945 $rect->{id} = $label . ' filled & filled'; 1946 Goo::Canvas::TextModel->new( 1947 $root, $label, $x+100, $y+130, -1, 'center', 1948 'font' => 'Sans 12', 1949 'fill-color' => 'blue', 1950 ); 1951} 1952 1953sub on_item_created { 1954 my ($canvas, $item, $model) = @_; 1955 $item->signal_connect( 1956 'motion_notify_event' => \&on_motion_notify 1957 ); 1958} 1959 1960sub on_motion_notify { 1961 my ($item, $target, $ev) = @_; 1962 return unless $target; 1963 my $model = $target->get_model; 1964 return unless $model && $model->{id}; 1965 print "$model->{id} received 'motion-notify' signal\n"; 1966} 1967 1968#}}} 1969 1970#{{{ Paths 1971package Paths; 1972use Gtk2; 1973use Glib qw(TRUE FALSE); 1974 1975sub create_canvas { 1976 my $pkg = shift; 1977 my ($swin, $canvas); 1978 my $vbox = Gtk2::VBox->new; 1979 $vbox->show; 1980 $vbox->set_border_width(4); 1981 $swin = Gtk2::ScrolledWindow->new(); 1982 $swin->set_shadow_type('in'); 1983 $swin->show; 1984 $vbox->add($swin); 1985 $canvas = Goo::Canvas->new; 1986 $canvas->set_size_request(600, 450); 1987 $canvas->set_bounds(0, 0, 1000, 1000); 1988 $canvas->show; 1989 $swin->add($canvas); 1990 my $root = Goo::Canvas::GroupModel->new; 1991 $canvas->set_root_item_model($root); 1992 setup_canvas($canvas); 1993 return $vbox; 1994} 1995 1996sub setup_canvas { 1997 my $canvas = shift; 1998 my $root = $canvas->get_root_item_model; 1999 my $path; 2000 $path = Goo::Canvas::PathModel->new( $root, "M 20 20 L 40 40", ); 2001 $path = Goo::Canvas::PathModel->new( $root, "M30 20 l20, 20", ); 2002 $path = Goo::Canvas::PathModel->new( $root, "M 60 20 H 80", ); 2003 $path = Goo::Canvas::PathModel->new( $root, "M60 40 h20", ); 2004 $path = Goo::Canvas::PathModel->new( $root, "M 100,20 V 40", ); 2005 $path = Goo::Canvas::PathModel->new( $root, "M 120 20 v 20", ); 2006 $path = Goo::Canvas::PathModel->new( $root, "M 140 20 h20 v20 h-20 z", ); 2007 $path = 2008 Goo::Canvas::PathModel->new( $root, 2009 "M 180 20 h20 v20 h-20 z m 5,5 h10 v10 h-10 z", 2010 "fill-color", "red", "fill-rule", 'even_odd', ); 2011 2012 $path = Goo::Canvas::PathModel->new( $root, "M 220 20 L 260 20 L 240 40 z", 2013 "fill-color", "red", "stroke-color", "blue", "line-width", 3.0, ); 2014 2015 # Test the bezier curve commands: CcSsQqTt. 2016 $path = 2017 Goo::Canvas::PathModel->new( $root, 2018 "M20,100 C20,50 100,50 100,100 S180,150 180,100", 2019 ); 2020 2021 $path = 2022 Goo::Canvas::PathModel->new( $root, "M220,100 c0,-50 80,-50 80,0 s80,50 80,0", 2023 ); 2024 2025 $path = 2026 Goo::Canvas::PathModel->new( $root, "M20,200 Q60,130 100,200 T180,200", ); 2027 2028 $path = Goo::Canvas::PathModel->new( $root, "M220,200 q40,-70 80,0 t80,0", ); 2029 2030 # Test the elliptical arc commands: Aa. 2031 $path = 2032 Goo::Canvas::PathModel->new( $root, "M200,500 h-150 a150,150 0 1,0 150,-150 z", 2033 "fill-color", "red", "stroke-color", "blue", "line-width", 5.0, ); 2034 2035 $path = 2036 Goo::Canvas::PathModel->new( $root, "M175,475 v-150 a150,150 0 0,0 -150,150 z", 2037 "fill-color", "yellow", "stroke-color", "blue", "line-width", 5.0, ); 2038 2039 $path = Goo::Canvas::PathModel->new( 2040 $root, 2041 "M400,600 l 50,-25 " 2042 . "a25,25 -30 0,1 50,-25 l 50,-25 " 2043 . "a25,50 -30 0,1 50,-25 l 50,-25 " 2044 . "a25,75 -30 0,1 50,-25 l 50,-25 " 2045 . "a25,100 -30 0,1 50,-25 l 50,-25", 2046 "stroke-color", 2047 "red", 2048 "line-width", 2049 5.0, 2050 ); 2051 2052 $path = Goo::Canvas::PathModel->new( $root, "M 525,75 a100,50 0 0,0 100,50", 2053 "stroke-color", "red", "line-width", 5.0, ); 2054 $path = Goo::Canvas::PathModel->new( $root, "M 725,75 a100,50 0 0,1 100,50", 2055 "stroke-color", "red", "line-width", 5.0, ); 2056 $path = Goo::Canvas::PathModel->new( $root, "M 525,200 a100,50 0 1,0 100,50", 2057 "stroke-color", "red", "line-width", 5.0, ); 2058 $path = Goo::Canvas::PathModel->new( $root, "M 725,200 a100,50 0 1,1 100,50", 2059 "stroke-color", "red", "line-width", 5.0, ); 2060} 2061 2062 2063#}}} 2064 2065#{{{ Focus 2066package Focus; 2067use Gtk2; 2068use Glib qw(TRUE FALSE); 2069 2070sub create_canvas { 2071 my $pkg = shift; 2072 my ($label, $swin, $canvas); 2073 my $vbox = Gtk2::VBox->new; 2074 $vbox->show; 2075 $vbox->set_border_width(4); 2076 $label = Gtk2::Label->new("Use Tab, Shift+Tab or the arrow keys to move the keyboard focus between the canvas items."); 2077 $swin = Gtk2::ScrolledWindow->new(); 2078 $swin->set_shadow_type('in'); 2079 $swin->show; 2080 $vbox->add($swin); 2081 $canvas = Goo::Canvas->new; 2082 $canvas->can_focus(TRUE); 2083 $canvas->set_size_request(600, 450); 2084 $canvas->set_bounds(0, 0, 1000, 1000); 2085 $canvas->show; 2086 $swin->add($canvas); 2087 my $root = Goo::Canvas::GroupModel->new; 2088 $canvas->set_root_item_model($root); 2089 $canvas->signal_connect('item-created', \&on_item_created); 2090 setup_canvas($canvas); 2091 return $vbox; 2092} 2093 2094sub setup_canvas { 2095 my $canvas = shift; 2096 create_focus_box ($canvas, 110, 80, 50, 30, "red"); 2097 create_focus_box ($canvas, 300, 160, 50, 30, "orange"); 2098 create_focus_box ($canvas, 500, 50, 50, 30, "yellow"); 2099 create_focus_box ($canvas, 70, 400, 50, 30, "blue"); 2100 create_focus_box ($canvas, 130, 200, 50, 30, "magenta"); 2101 create_focus_box ($canvas, 200, 160, 50, 30, "green"); 2102 create_focus_box ($canvas, 450, 450, 50, 30, "cyan"); 2103 create_focus_box ($canvas, 300, 350, 50, 30, "grey"); 2104 create_focus_box ($canvas, 900, 900, 50, 30, "gold"); 2105 create_focus_box ($canvas, 800, 150, 50, 30, "thistle"); 2106 create_focus_box ($canvas, 600, 800, 50, 30, "azure"); 2107 create_focus_box ($canvas, 700, 250, 50, 30, "moccasin"); 2108 create_focus_box ($canvas, 500, 100, 50, 30, "cornsilk"); 2109 create_focus_box ($canvas, 200, 750, 50, 30, "plum"); 2110 create_focus_box ($canvas, 400, 800, 50, 30, "orchid"); 2111} 2112 2113sub create_focus_box { 2114 my ($canvas, $x, $y, $width, $height, $color) = @_; 2115 my $root = $canvas->get_root_item_model; 2116 my $item = Goo::Canvas::RectModel->new( 2117 $root, $x, $y, $width, $height, 2118 'stroke-pattern' => undef, 2119 'fill-color' => $color, 2120 'line-width' => 5, 2121 'can-focus' => TRUE, 2122 ); 2123 $item->{id} = $color; 2124} 2125 2126sub on_item_created { 2127 my ($canvas, $item, $model) = @_; 2128 if ( $model->isa('Goo::Canvas::RectModel')) { 2129 $item->signal_connect('focus_in_event' => \&on_focus_in); 2130 $item->signal_connect('focus_out_event' => \&on_focus_out); 2131 $item->signal_connect('button_press_event' => \&on_button_press); 2132 $item->signal_connect('key_press_event' => \&on_key_press); 2133 } 2134} 2135 2136sub on_key_press { 2137 my($item, $target, $ev) = @_; 2138 my $model = $item->get_model; 2139 print $model->{id} || "Unknown", " received key_press event\n"; 2140 return FALSE; 2141} 2142sub on_button_press { 2143 my($item, $target, $ev) = @_; 2144 my $model = $item->get_model; 2145 print $model->{id} || "Unknown", " received button_press event\n"; 2146 my $canvas = $item->get_canvas; 2147 $canvas->grab_focus($item); 2148 return TRUE; 2149} 2150sub on_focus_out { 2151 my ($item, $target, $ev) = @_; 2152 my $model = $item->get_model; 2153 print $model->{id} || "Unknown", " received focus_out event\n"; 2154 $model->set("stroke-pattern" => undef); 2155 return FALSE; 2156} 2157sub on_focus_in { 2158 my ($item, $target, $ev) = @_; 2159 my $model = $item->get_model; 2160 print $model->{id} || "Unknown", " received focus_in event\n"; 2161 $model->set("stroke-color" => "black"); 2162 return FALSE; 2163} 2164 2165#}}} 2166 2167#{{{ Animation 2168package Animation; 2169use Gtk2; 2170use Glib qw(TRUE FALSE); 2171 2172sub create_canvas { 2173 my $pkg = shift; 2174 my ($hbox, $w, $swin, $canvas); 2175 my $vbox = Gtk2::VBox->new; 2176 $vbox->show; 2177 $vbox->set_border_width(4); 2178 $hbox = Gtk2::HBox->new(FALSE, 4); 2179 $vbox->pack_start($hbox, FALSE, FALSE, 0); 2180 $hbox->show; 2181 $w = Gtk2::ToggleButton->new('Start Animation'); 2182 $hbox->pack_start($w, FALSE, FALSE, 0); 2183 $w->show; 2184 $w->signal_connect('toggled', \&toggle_animation_clicked); 2185 $swin = Gtk2::ScrolledWindow->new(); 2186 $swin->set_shadow_type('in'); 2187 $swin->show; 2188 $vbox->add($swin); 2189 $canvas = Goo::Canvas->new; 2190 $canvas->set_size_request(600, 450); 2191 $canvas->set_bounds(0, 0, 1000, 1000); 2192 $canvas->show; 2193 $w->{canvas} = $canvas; 2194 $swin->add($canvas); 2195 my $root = Goo::Canvas::GroupModel->new; 2196 $canvas->set_root_item_model($root); 2197 setup_canvas($canvas); 2198 return $vbox; 2199} 2200 2201sub setup_canvas { 2202 my $canvas = shift; 2203 my $root = $canvas->get_root_item_model; 2204 my ($rect1, $rect2, $rect3, $rect4, $ellipse1, $ellipse2); 2205 # Absolute 2206 $ellipse1 = Goo::Canvas::EllipseModel->new( 2207 $root, 0, 0, 25, 15, 2208 'fill-color' => 'blue', 2209 ); 2210 $ellipse1->translate(100, 100); 2211 $rect1 = Goo::Canvas::RectModel->new( 2212 $root, -10, -10, 20, 20, 2213 'fill-color' => 'blue', 2214 ); 2215 $rect1->translate(100, 200); 2216 $rect3 = Goo::Canvas::RectModel->new( 2217 $root, -10, -10, 20, 20, 2218 'fill-color' => 'blue', 2219 ); 2220 $rect3->translate(200, 200); 2221 # Relative 2222 $ellipse2 = Goo::Canvas::EllipseModel->new( 2223 $root, 0, 0, 25, 15, 2224 'fill-color' => 'red', 2225 ); 2226 $ellipse2->translate(100, 400); 2227 $rect2 = Goo::Canvas::RectModel->new( 2228 $root, -10, -10, 20, 20, 2229 'fill-color' => 'red', 2230 ); 2231 $rect2->translate(100, 500); 2232 $rect4 = Goo::Canvas::RectModel->new( 2233 $root, -10, -10, 20, 20, 2234 'fill-color' => 'red', 2235 ); 2236 $rect4->translate(200, 500); 2237 $canvas->{items} = [$rect1, $rect2, $rect3, $rect4, $ellipse1, $ellipse2]; 2238} 2239 2240sub toggle_animation_clicked { 2241 my $but = shift; 2242 if ( $but->get_active ) { 2243 $but->set_label('Stop Animation'); 2244 start_animation($but); 2245 } 2246 else { 2247 $but->set_label('Start Animation'); 2248 stop_animation($but); 2249 } 2250} 2251sub start_animation { 2252 my $but = shift; 2253 my ($rect1, $rect2, $rect3, $rect4, $ellipse1, $ellipse2) = @{$but->{canvas}{items}}; 2254 2255 # Absolute 2256 $ellipse1->set_simple_transform (100, 100, 1, 0); 2257 $ellipse1->animate (500, 100, 2, 720, TRUE, 2000, 40, 2258 'bounce'); 2259 2260 $rect1->set_simple_transform (100, 200, 1, 0); 2261 $rect1->animate (100, 200, 1, 350, TRUE, 40 * 36, 40, 2262 'restart'); 2263 2264 $rect3->set_simple_transform (200, 200, 1, 0); 2265 $rect3->animate (200, 200, 3, 0, TRUE, 400, 40, 2266 'bounce'); 2267 2268 # Relative 2269 $ellipse2->set_simple_transform (100, 400, 1, 0); 2270 $ellipse2->animate (400, 0, 2, 720, FALSE, 2000, 40, 2271 'bounce'); 2272 2273 $rect2->set_simple_transform (100, 500, 1, 0); 2274 $rect2->animate (0, 0, 1, 350, FALSE, 40 * 36, 40, 2275 'restart'); 2276 2277 $rect4->set_simple_transform (200, 500, 1, 0); 2278 $rect4->animate (0, 0, 3, 0, FALSE, 400, 40, 2279 'bounce'); 2280} 2281 2282sub stop_animation { 2283 my $but = shift; 2284 my ($rect1, $rect2, $rect3, $rect4, $ellipse1, $ellipse2) = @{$but->{canvas}{items}}; 2285 $ellipse1->stop_animation (); 2286 $ellipse2->stop_animation (); 2287 $rect1->stop_animation (); 2288 $rect2->stop_animation (); 2289 $rect3->stop_animation (); 2290 $rect4->stop_animation (); 2291} 2292 2293#}}} 2294 2295#{{{ Clipping 2296package Clipping; 2297use Gtk2; 2298use Glib qw(TRUE FALSE); 2299 2300sub create_canvas { 2301 my $pkg = shift; 2302 my ($hbox, $swin, $canvas); 2303 my $vbox = Gtk2::VBox->new; 2304 $vbox->show; 2305 $vbox->set_border_width(4); 2306 $swin = Gtk2::ScrolledWindow->new(); 2307 $swin->set_shadow_type('in'); 2308 $swin->show; 2309 $vbox->add($swin); 2310 $canvas = Goo::Canvas->new; 2311 $canvas->set_size_request(600, 450); 2312 $canvas->set_bounds(0, 0, 1000, 1000); 2313 $canvas->show; 2314 $swin->add($canvas); 2315 setup_canvas($canvas); 2316 return $vbox; 2317} 2318 2319sub setup_canvas { 2320 my $canvas = shift; 2321 my $root = Goo::Canvas::GroupModel->new; 2322 $canvas->set_root_item_model($root); 2323 my $model; 2324 $model = Goo::Canvas::EllipseModel->new( 2325 $root, 0, 0, 50, 30, 2326 'fill-color' => 'blue', 2327 ); 2328 $model->translate(100, 100); 2329 $model->rotate(30, 0, 0); 2330 $canvas->get_item($model)->signal_connect( 2331 'button-press-event' => \&on_button_press, 2332 "Blue ellipse (unclipped)" 2333 ); 2334 $model = Goo::Canvas::RectModel->new( 2335 $root, 200, 50, 100, 100, 2336 'fill-color' => 'red', 2337 'clip-fill-rule' => 'even-odd' 2338 ); 2339 $canvas->get_item($model)->signal_connect('button-press-event' => \&on_button_press, 2340 "Red rectangle (unclipped)"); 2341 $model = Goo::Canvas::RectModel->new( 2342 $root, 380, 50, 100, 100, 2343 'fill-color' => 'yellow' 2344 ); 2345 $canvas->get_item($model)->signal_connect('button-press-event' => \&on_button_press, 2346 "Yellow rectangle(unclipped)"); 2347 # clipped items 2348 $model = Goo::Canvas::EllipseModel->new( 2349 $root, 0, 0, 50, 30, 2350 'fill-color' => 'blue', 2351 'clip-path' => "M 0 0 h 100 v 100 h -100 Z" 2352 ); 2353 $model->translate (100, 300); 2354 $model->rotate (30, 0, 0); 2355 $canvas->get_item($model)->signal_connect('button-press-event' => \&on_button_press, 2356 "Blue ellipse"); 2357 $model = Goo::Canvas::RectModel->new( 2358 $root, 200, 250, 100, 100, 2359 'fill-color' => 'red', 2360 'clip-path' => "M 250 300 h 100 v 100 h -100 Z", 2361 'clip-fill-rule' => 'even-odd' 2362 ); 2363 $canvas->get_item($model)->signal_connect('button-press-event' => \&on_button_press, 2364 "Red rectangle"); 2365 $model = Goo::Canvas::RectModel->new( 2366 $root, 380, 250, 100, 100, 2367 'fill-color' => 'yellow', 2368 'clip-path' => "M480,230 l40,100 l-80 0 z", 2369 ); 2370 $canvas->get_item($model)->signal_connect('button-press-event' => \&on_button_press, 2371 'Yellow rectangle'); 2372 # Table with clipped items 2373 my $table = Goo::Canvas::TableModel->new($root); 2374 $table->translate (200, 400); 2375 $table->rotate (30, 0, 0); 2376 $model = Goo::Canvas::EllipseModel->new( 2377 $table, 0, 0, 50, 30, 2378 'fill-color' => 'blue', 2379 'clip-path' => "M 0 0 h 100 v 100 h -100 Z", 2380 ); 2381 $model->translate (100, 300); 2382 $model->rotate (30, 0, 0); 2383 $canvas->get_item($model)->signal_connect('button-press-event' => \&on_button_press, 2384 'Blue ellipse'); 2385 $model = Goo::Canvas::RectModel->new( 2386 $table, 200, 250, 100, 100, 2387 'fill-color' => 'red', 2388 "clip-path" => "M 250 300 h 100 v 100 h -100 Z", 2389 "clip-fill-rule" => 'even-odd', 2390 ); 2391 $table->set_child_properties( 2392 $model, 2393 'column' => 1, 2394 ); 2395 $canvas->get_item($model)->signal_connect('button-press-event' => \&on_button_press, 2396 'Red rectangle'); 2397 $model = Goo::Canvas::RectModel->new( 2398 $table, 380, 250, 100, 100, 2399 'fill-color' => 'yellow', 2400 'clip-path' => "M480,230 l40,100 l-80 0 z" 2401 ); 2402 $table->set_child_properties( 2403 $model, 2404 'column' => 2, 2405 ); 2406 $canvas->get_item($model)->signal_connect('button-press-event' => \&on_button_press, 2407 'Yellow rectangle'); 2408} 2409 2410sub on_button_press { 2411 my ($item, $target, $ev, $id) = @_; 2412 printf "%s received 'button-press' at %g, %g, (root: %g, %g)\n", 2413 $id, $ev->x, $ev->y, $ev->x_root, $ev->y_root; 2414 return TRUE; 2415} 2416 2417#}}} 2418
