ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/kgsueme/game.pl
(Generate patch)

Comparing kgsueme/kgsueme/game.pl (file contents):
Revision 1.63 by pcg, Thu Jun 19 01:29:40 2003 UTC vs.
Revision 1.64 by pcg, Sun Jun 22 20:47:12 2003 UTC

… …
243 243
244 $self->{boardbox}->pack_start((my $aspect_frame = new Gtk2::AspectFrame "", 0.5, 0.5, 1, 0), 1, 1, 0); 244 $self->{boardbox}->pack_start((my $aspect_frame = new Gtk2::AspectFrame "", 0.5, 0.5, 1, 0), 1, 1, 0);
245 $aspect_frame->set (border_width => 0, shadow_type => 'none', label_xalign => 0.5); 245 $aspect_frame->set (border_width => 0, shadow_type => 'none', label_xalign => 0.5);
246 $self->{board_label} = $aspect_frame->get_label_widget; 246 $self->{board_label} = $aspect_frame->get_label_widget;
247 247
248 $aspect_frame->add($self->{canvas} = new Gtk2::DrawingArea); 248 $aspect_frame->add($self->{board} = new board size => $self->{size});
249 $self->{canvas}->double_buffered (0);
250
251 $self->{canvas}->signal_connect(configure_event => \&configure_event, $self);
252 $self->{canvas}->signal_connect(expose_event => \&expose_event, $self);
253 249
254 # RIGHT PANE 250 # RIGHT PANE
255 251
256 $self->{hpane}->pack2(($self->{vpane} = new Gtk2::VPaned), 1, 1); 252 $self->{hpane}->pack2(($self->{vpane} = new Gtk2::VPaned), 1, 1);
257 $self->{hpane}->set(position_set => 1); 253 $self->{hpane}->set(position_set => 1);
… …
316 312
317 $self->SUPER::part; 313 $self->SUPER::part;
318 $self->destroy; 314 $self->destroy;
319} 315}
320 316
321sub configure_event {
322 my ($widget, $event, $self) = @_;
323 delete $self->{stack};
324 delete $self->{pixbuf};
325 delete $self->{board_shown};
326 delete $self->{background};
327 $self->repaint_board;
328 0;
329}
330
331sub expose_event {
332 my ($widget, $event, $self) = @_;
333
334 $self->{pixbuf} or return;
335
336 $self->redraw ($event->area->values);
337
338 0;
339}
340
341# something Gtk2 fixed
342sub INTERP_NEAREST (){ 'nearest' }
343sub INTERP_TILES (){ 'tiles' }
344sub INTERP_BILINEAR (){ 'bilinear' }
345sub INTERP_HYPER (){ 'hyper' }
346
347sub new_pixbuf {
348 my ($w, $h, $alpha, $fill) = @_;
349
350 my $pixbuf = new Gtk2::Gdk::Pixbuf 'rgb', $alpha, 8, $w, $h;
351 $pixbuf->fill ($fill) if defined $fill;
352
353 $pixbuf;
354}
355
356sub scale_pixbuf {
357 my ($src, $w, $h, $mode) = @_;
358
359 my $dst = new_pixbuf $w, $h, 1;
360
361 $src->scale(
362 $dst, 0, 0, $w, $h, 0, 0,
363 $w / $src->get_width, $h / $src->get_height,
364 $mode,
365 );
366
367 $dst;
368}
369
370# create a stack of stones
371sub create_stack {
372 my ($self, $mark, $size, $rand) = @_;
373
374 my $shadow = $size * 0.05;
375
376 my $c = \$self->{stack}{$mark};
377 unless ($$c) {
378 for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) {
379 my $base = new_pixbuf $size + $shadow, $size + $shadow, 1, 0x00000000;
380
381 # zeroeth the shadow
382 if ($mark & (MARK_B | MARK_W)) {
383 # the -0.5's are a mystery to me
384 $::shadow_img->composite (
385 $base, $shadow, $shadow, $size, $size, $shadow - 0.5, $shadow - 0.5,
386 $size / $::shadow_img->get_width, $size / $::shadow_img->get_height,
387 $::config->{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 192
388 );
389 }
390
391 # first the big stones (handicap stones could be different)
392 for ([MARK_B, $mark & MARK_MOVE ? 255 : 255],
393 [MARK_W, $mark & MARK_MOVE ? 255 : 255],
394 [MARK_GRAY_B, 128],
395 [MARK_GRAY_W, 128]) {
396 my ($mask, $alpha) = @$_;
397 if ($mark & $mask) {
398 $stone->composite (
399 $base, 0, 0, $size, $size, 0, 0,
400 $size / $stone->get_width, $size / $stone->get_height,
401 $::config->{speed} ? INTERP_NEAREST : INTERP_BILINEAR, $alpha
402 );
403 }
404 }
405
406 # then the small stones
407 for ([MARK_SMALL_B, $::black_img[$rand % @::black_img]],
408 [MARK_SMALL_W, $::white_img[$rand % @::white_img]]) {
409 my ($mask, $img) = @$_;
410 if ($mark & $mask) {
411 $img->composite (
412 $base, (int ($size / 4)) x2, (ceil ($size / 2 + 1)) x2, ($size / 4) x2,
413 $size / $img->get_width / 2, $size / $img->get_height / 2,
414 $::config->{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 224
415 );
416 }
417 }
418
419 # and lastly any markers
420 my $dark_bg = ! ! ($mark & (MARK_B | MARK_GRAY_B));
421
422 for ([MARK_CIRCLE, $::circle_img[$dark_bg]],
423 [MARK_TRIANGLE, $::triangle_img[$dark_bg]],
424 [MARK_SQUARE, $::square_img[$dark_bg]]) {
425 my ($mask, $img) = @$_;
426 if ($mark & $mask) {
427 $img->composite (
428 $base, 0, 0, $size, $size, 0, 0,
429 $size / $img->get_width, $size / $img->get_height,
430 $::config->{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 192
431 );
432 }
433 }
434
435 push @$$c, $base;
436 }
437 }
438
439 $$c->[$rand % @$$c];
440}
441
442sub pixbuf_text {
443 my ($pixbuf, $colour, $x, $y, $height, $text) = @_;
444
445 my @c = grep $_,
446 map $::font[$colour][$::fontmap{$_}],
447 split //, $text;
448
449 if (@c) {
450 my $spacing = $height * 0.1;
451 my $s = $height / List::Util::max map $_->get_height, @c;
452 my $W = List::Util::sum map $_->get_width, @c;
453
454 $x -= ($W * $s + $spacing * (@c - 1)) * 0.5;
455 $y -= $height * 0.5;
456
457 for (@c) {
458 my $w = $_->get_width * $s;
459 # +2 == don't fight the rounding
460 $_->composite ($pixbuf,
461 $x, $y, $w+2, $height+2, $x, $y, $s, $s,
462 $::config->{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 255);
463
464 $x += $w + $spacing;
465 }
466 }
467}
468
469sub pixbuf_rect {
470 my ($pb, $colour, $x1, $y1, $x2, $y2, $alpha) = @_;
471 # we fake lines by... a horrible method :/
472 my $colour_pb = new_pixbuf 1, 1, 0, $colour;
473 $colour_pb->composite ($pb, $x1, $y1, $x2 - $x1 + 1, $y2 - $y1 + 1, $x1, $y1, $x2 + 1, $y2 + 1,
474 INTERP_NEAREST, $alpha);
475}
476
477sub repaint_board {
478 my ($self) = @_;
479 my $canvas = $self->{canvas};
480
481 return unless $self->{board};
482
483 my ($w, $h) = ($canvas->allocation->values)[2,3];
484
485 die "FATAL: board aspect ratio != 1" unless $w == $h;
486
487 my $s = $w;
488
489 return unless $s >= 200;
490
491 my $size = $self->{size};
492
493 # we leave enough space for the shadows.. I like smaller stones, and we
494 # do no need to do the nifty recursive screen updates that goban2 does
495 my $border = int ($s / ($size + 3) * 0.5);
496 my $s2 = $s - $border * 2;
497 my $edge = int ($s2 / ($size + 1) * 0.96) - ($::config->{randomize} ? 3 : 0);
498 my $ofs = int ($edge / 2);
499
500 my @k = map int ($s2 * $_ / ($size+1) + $border + 0.5), 0 .. $size;
501
502 my $pixbuf;
503
504 my $oldboard;
505
506 if ($self->{background}) {
507 if ($oldboard = $self->{board_shown}) {
508 $pixbuf = $self->{pixbuf};
509 } else {
510 $pixbuf = $self->{background}->copy;
511 $self->{canvas}->queue_draw_area (0, 0, $s, $s);
512 }
513 } else {
514 $self->{canvas}->queue_draw_area (0, 0, $s, $s);
515
516 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height);
517
518 if ($s < $bw && $s < $bh) {
519 $pixbuf = new_pixbuf $s, $s, 0;
520 $::board_img->copy_area (0, 0, $s, $s, $pixbuf, 0, 0);
521 } else {
522 $pixbuf = scale_pixbuf $::board_img, $s, $s, $::config->{speed} ? INTERP_NEAREST : INTERP_TILES;
523 }
524
525 my $linew = int ($s / 40 / $size);
526
527 # ornamental border... we have time to waste :/
528 pixbuf_rect $pixbuf, 0xffcc7700, 0, 0, $s-1, $linew, 255;
529 pixbuf_rect $pixbuf, 0xffcc7700, 0, 0, $linew, $s-1, 255;
530 pixbuf_rect $pixbuf, 0xffcc7700, $s-$linew-1, 0, $s-1, $s-1, 255;
531 pixbuf_rect $pixbuf, 0xffcc7700, 0, $s-$linew-1, $s-1, $s-1, 255;
532
533 for my $i (1 .. $size) {
534 pixbuf_rect $pixbuf, 0x44111100, $k[$i] - $linew, $k[1] - $linew, $k[$i] + $linew, $k[$size] + $linew, 192;
535 pixbuf_rect $pixbuf, 0x44111100, $k[1] - $linew, $k[$i] - $linew, $k[$size] + $linew, $k[$i] + $linew, 192;
536
537 # 38 max, but we allow a bit more
538 my $label = (qw(- A B C D E F G H J K L M N O P Q R S T U V W X Y Z
539 AA BB CC DD EE FF GG HH JJ KK LL MM NN OO PP QQ RR SS TT UU VV WW XX YY ZZ))[$i];
540
541 pixbuf_text $pixbuf, 0, $k[$i], $border, $ofs, $label;
542 pixbuf_text $pixbuf, 0, $k[$i], $s2 + $border, $ofs, $label;
543 pixbuf_text $pixbuf, 0, $border, $k[$i], $ofs, $size - $i + 1;
544 pixbuf_text $pixbuf, 0, $s2 + $border, $k[$i], $ofs, $size - $i + 1;
545
546 $a++;
547 $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK...
548 }
549
550 # hoshi points
551 my $hoshi = sub {
552 my ($x, $y) = @_;
553 my $hs = int ($edge / 4) | 1;
554 $x = $k[$x] - $hs / 2; $y = $k[$y] - $hs / 2;
555
556 # we use the shadow mask... not perfect, but I want to finish this
557 $::shadow_img->composite ($pixbuf,
558 $x, $y, $hs + 1, $hs + 1, $x, $y,
559 $hs / $::shadow_img->get_width, $hs / $::shadow_img->get_height,
560 $::config->{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 255);
561 };
562
563 my $h1 = $size < 10 ? 3 : 4; # corner / edge offset
564 $hoshi->($h1, $h1);
565 $hoshi->($size - $h1 + 1, $h1);
566 $hoshi->($h1, $size - $h1 + 1);
567 $hoshi->($size - $h1 + 1, $size - $h1 + 1);
568
569 if ($size % 2) { # on odd boards, also the remaining 5
570 my $h2 = ($size + 1) / 2;
571 if ($size > 10) {
572 $hoshi->($h1, $h2);
573 $hoshi->($size - $h1 + 1, $h2);
574 $hoshi->($h2, $size - $h1 + 1);
575 $hoshi->($h2, $h1);
576 }
577 # the tengen
578 $hoshi->($h2, $h2);
579 }
580
581 unless ($::config->{conserve_memory} > 1) {
582 $self->{background} = $pixbuf;
583 $pixbuf = $pixbuf->copy;
584 }
585 }
586
587 $self->{pixbuf} = $pixbuf;
588
589 for my $x (1 .. $size) {
590 for my $y (1 .. $size) {
591 my $rand = ($x ^ $y ^ 0x5555);
592
593 my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs);
594
595 if ($::config->{randomize}) {
596 $dx += ($rand % 7) - 3;
597 $dy += ($rand / 3 % 7) - 3;
598 }
599
600 my $shadow = $edge * 0.05;
601 my $area = [$dx, $dy, $edge + $shadow, $edge + $shadow];
602
603 my $mark = $self->{board}{board}[$x-1][$y-1];
604 my $old = $oldboard ? $oldboard->{board}[$x-1][$y-1] : 0;
605
606 if ($oldboard) {
607 next if $old == $mark; # no change
608
609 $self->{background}->copy_area (@$area, $pixbuf, $dx, $dy);
610 }
611
612 if ($mark) {
613 my $pb = $self->create_stack($mark, $edge, $rand);
614
615 $pb->composite ($pixbuf, @$area,
616 $dx, $dy, 1, 1, $::config->{speed} ? INTERP_NEAREST : INTERP_NEAREST, 255);
617
618 # labels are handled here because they are quite rare
619 if ($mark & MARK_LABEL) {
620 my $white = $mark & (MARK_W | MARK_GRAY_W) ? 0 : 1;
621
622 if ($white) {
623 pixbuf_text $pixbuf, 0,
624 $k[$x] + $ofs * 0.1, $k[$y] + $ofs * 0.1, $ofs * 0.7,
625 $self->{board}{label}[$x-1][$y-1];
626 }
627 pixbuf_text $pixbuf, $white,
628 $k[$x], $k[$y], $ofs * 0.7,
629 $self->{board}{label}[$x-1][$y-1];
630 }
631 }
632
633 if ($oldboard) {
634 $self->redraw (@$area);
635 }
636 }
637 }
638
639 $self->{board_shown} = Storable::dclone $self->{board};
640}
641
642sub redraw {
643 my ($self, $x, $y, $w, $h) = @_;
644
645 if ($self->{pixbuf}) {
646 $self->{canvas}->window->draw_pixbuf ($self->{canvas}->style->white_gc, $self->{pixbuf},
647 $x, $y, $x, $y, $w, $h,
648 "normal", 0, 0);
649 $self->{canvas}->window->draw_rectangle ($self->{canvas}->style->black_gc, 0,
650 $x - 1, $y - 1, $w + 2, $h + 2) if $::DEBUG_EXPOSE;
651 }
652}
653
654sub update_board { 317sub update_board {
655 my ($self) = @_; 318 my ($self) = @_;
656 return unless $self->{path}; 319 return unless $self->{path};
657 320
658 my $move = int $self->{moveadj}->get_value; 321 my $move = int $self->{moveadj}->get_value;
659 322
660 my $running = $move == @{$self->{path}}; 323 my $running = $move == @{$self->{path}};
661 324
662 $self->{board_label}->set_text ("Move " . ($move - 1)); 325 $self->{board_label}->set_text ("Move " . ($move - 1));
663 326
664 $self->{board} = new KGS::Game::Board $self->{size}; 327 $self->{cur_board} = new KGS::Game::Board $self->{size};
665 $self->{board}->interpret_path ([@{$self->{path}}[0 .. $move - 1]]); 328 $self->{cur_board}->interpret_path ([@{$self->{path}}[0 .. $move - 1]]);
666 329
667 for my $colour (WHITE, BLACK) { 330 for my $colour (WHITE, BLACK) {
668 $self->{userpanel}[$colour]->set_state ( 331 $self->{userpanel}[$colour]->set_state (
669 $self->{board}{captures}[$colour], 332 $self->{cur_board}{captures}[$colour],
670 $self->{board}{timer}[$colour], 333 $self->{cur_board}{timer}[$colour],
671 ($running && $self->{lastmove_colour} == !$colour) 334 ($running && $self->{lastmove_colour} == !$colour)
672 ? $self->{lastmove_time} : 0 335 ? $self->{lastmove_time} : 0
673 ); 336 );
674 } 337 }
675 338
676 $self->repaint_board; 339 $self->{board}->set_board ($self->{cur_board});
677} 340}
678 341
679sub event_update_tree { 342sub event_update_tree {
680 my ($self) = @_; 343 my ($self) = @_;
681 344
… …
771 } 434 }
772 $self->{left}->show_all; 435 $self->{left}->show_all;
773 436
774 # view text 437 # view text
775 438
439 eval { #d#
776 my @ga; 440 my @ga;
777 $ga[0] = "\nType: " . (util::toxml $gametype{$self->type}) 441 $ga[0] = "\nType: " . (util::toxml $gametype{$self->type})
778 . " (" . (util::toxml $gameopt{$self->option}) . ")"; 442 . " (" . (util::toxml $gameopt{$self->option}) . ")";
779 $ga[1] = "\nFlags:"; 443 $ga[1] = "\nFlags:";
780 $ga[1] .= " valid" if $self->is_valid; 444 $ga[1] .= " valid" if $self->is_valid;
… …
805 } 469 }
806 } 470 }
807 $text .= "</infoblock>"; 471 $text .= "</infoblock>";
808 472
809 $self->{gatext} = \@ga; 473 $self->{gatext} = \@ga;
474 };
810 475
811 $self->{text}->append_text ($text); 476 $self->{text}->append_text ($text);
812} 477}
813 478
814sub event_update_rules { 479sub event_update_rules {

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines