| 435 | | # insert row reduction here |
| 436 | | |
| 437 | | # { moveid => 123, method => 'level', versions => 'rb,y,ru,sa' } |
| 438 | | # @moves = ( |
| 439 | | # { moveid => 123, versions => { rb => 1, y => 1, ... } }, |
| 440 | | # ... |
| 441 | | # ); |
| 442 | | |
| 443 | | |
| 444 | | # |
| 445 | | ################################################################################# |
| 446 | | ## MEGA TODO: this all needs rewriting really. find a way to make it work without hacking up the row objects. |
| 447 | | ## consider javascriptifying it, a lot. moves are complicated. but make a nice display for fallback, of course. |
| 448 | | ## also I think the TMs could stand to be reverted. |
| 449 | | # |
| 450 | | ## sort level moves |
| 451 | | #my @tmplevel = sort { |
| 452 | | # $a->{level} <=> $b->{level} || |
| 453 | | # $MoveData[ $a->{moveid} ]->name cmp $MoveData[ $b->{moveid} ]->name |
| 454 | | #} @{ $moves{level} }; |
| 455 | | # |
| 456 | | #OUTER: for my $i (0 .. $#tmplevel-2) { |
| 457 | | # my $m = $tmplevel[$i]; |
| 458 | | # next if $m->{done}; |
| 459 | | # $m->{done} = 1; |
| 460 | | # |
| 461 | | # # find a record with the same moveid |
| 462 | | # INNER: for my $j (0 .. $#tmplevel-1) { |
| 463 | | # next if $i == $j; |
| 464 | | # my $m2 = $tmplevel[$j]; |
| 465 | | # |
| 466 | | # next if $m->{moveid} != $m2->{moveid}; |
| 467 | | # next if share_count([ keys %{$m->{version}} ], [ keys %{$m2->{version}} ]); |
| 468 | | # |
| 469 | | # # don't de-sort moves; we can't skip $m over another move with a shared version and different level |
| 470 | | # for my $k ($i < $j ? $i .. $j : $j .. $i) { |
| 471 | | # next INNER if |
| 472 | | # $tmplevel[$k]{level} != $m->{level} and |
| 473 | | # share_count([ keys %{$tmplevel[$k]{version}} ], [ keys %{$m->{version}} ]); |
| 474 | | # } |
| 475 | | # |
| 476 | | # # now we have a different move row with the same move and different versions, |
| 477 | | # # so shift the current move to this position. |
| 478 | | # splice @tmplevel, $j, 0, $m; |
| 479 | | # splice @tmplevel, ($i < $j ? $i : $i + 1), 1; |
| 480 | | # redo OUTER; |
| 481 | | # } |
| 482 | | #} |
| 483 | | # |
| 484 | | # merge adjacent moves with the same moveid |
| 485 | | |
| 486 | | |
| 487 | | #VEE VEE VEE: don't shuffle and merge separately, just do it all at once, moving as far as possible to find a similar move :B |
| 488 | | #perhaps even do it one moveid at a time...? every move is trapped by the move ahead and behind it... |
| 489 | | for my $i (1 .. $#{ $moves{level} }) { |
| 490 | | next unless defined $moves{level}[$i]; |
| 491 | | next unless $moves{level}[$i - 1]{moveid} == $moves{level}[$i]{moveid}; |
| 492 | | |
| 493 | | for my $v (keys %{ $moves{level}[$i]{versions} }) { |
| 494 | | next if exists $moves{level}[$i - 1]{versions}{$v}; |
| 495 | | $moves{level}[$i - 1]{versions}{$v} = $moves{level}[$i]{versions}{$v}; |
| 496 | | delete $moves{level}[$i]{versions}{$v}; |
| 497 | | } |
| 498 | | if (scalar keys %{ $moves{level}[$i]{versions} } == 0) { # only moveid left |
| 499 | | splice @{ $moves{level} }, $i, 1; |
| 500 | | redo; |
| 501 | | } |
| 502 | | } |
| 503 | | #@{ $moves{level} } = @tmplevel; |
| 504 | | # |
| 505 | | ## sort everything else (just by name) |
| 506 | | #for my $method (qw/egg tutor other machine/) { |
| 507 | | # next unless $moves{$method}; |
| 508 | | # @{ $moves{$method} } = sort { |
| 509 | | # $MoveData[ $a->{moveid} ]->name cmp |
| 510 | | # $MoveData[ $b->{moveid} ]->name |
| 511 | | # } @{ $moves{$method} }; |
| 512 | | #} |
| | 427 | # The following mess is the code to compact the level move display as much |
| | 428 | # as humanly possible. This is the third incarnation of the code, and it |
| | 429 | # is the most efficient, well-written, and well-documented version so far. |
| | 430 | # I am quite pleased with it. Enjoy. |
| | 431 | |
| | 432 | # This is for slight ease of typing, as well as reading with coloring. |
| | 433 | my $lev_moves = $moves{level}; |
| | 434 | |
| | 435 | # Continue to run through the list as long as we are still doing something. |
| | 436 | # There should be no possible way that this creates an infinite loop. |
| | 437 | my $merges; |
| | 438 | do { |
| | 439 | $merges = 0; |
| | 440 | my $i = -1; |
| | 441 | while (++$i <= $#$lev_moves) { # shouldn't use a for since the size of the array changes |
| | 442 | # find the next row index with the same moveid |
| | 443 | my $next_idx = first { $lev_moves->[$_]{moveid} == $lev_moves->[$i]{moveid} } $i + 1 .. $#$lev_moves; |
| | 444 | next if not defined $next_idx; |
| | 445 | |
| | 446 | # make the following mess easier to read/write |
| | 447 | my $this = $lev_moves->[$i]; |
| | 448 | my $next = $lev_moves->[$next_idx]; |
| | 449 | |
| | 450 | # Ensure there are no level-up moves between these two that have the |
| | 451 | # same version, as that would wreck the ordering. |
| | 452 | # Note that there need to be TWO checks; one going in each direction. |
| | 453 | # For example: |
| | 454 | # 1 - Tail Whip |
| | 455 | # 2 - Bubble |
| | 456 | # - 3 Tail Whip |
| | 457 | # It is illegal to move the first Tail Whip forwards, but the last one |
| | 458 | # can be moved backwards with no problems. |
| | 459 | my ($forward_ok, $backward_ok) = (1, 1); |
| | 460 | my %versions = map { $_ => 1 } keys(%{ $this->{versions} }), keys(%{ $next->{versions} }); |
| | 461 | for my $version (keys %versions) { |
| | 462 | for my $mid_idx ($i + 1 .. $next_idx - 1) { |
| | 463 | next if not defined $lev_moves->[$mid_idx]{versions}{$version}; |
| | 464 | $forward_ok = 0 if defined $this->{versions}{$version} && |
| | 465 | $lev_moves->[$mid_idx]{versions}{$version} > $this->{versions}{$version}; |
| | 466 | |
| | 467 | $backward_ok = 0 if defined $next->{versions}{$version} && |
| | 468 | $lev_moves->[$mid_idx]{versions}{$version} < $next->{versions}{$version}; |
| | 469 | } |
| | 470 | } |
| | 471 | next if not $forward_ok and not $backward_ok; |
| | 472 | |
| | 473 | # merge one row into the other, forward by default (this is arbitrary) |
| | 474 | my ($from, $into, $from_idx) = $forward_ok ? ($this, $next, $i) : ($next, $this, $next_idx); |
| | 475 | for my $version (keys %{ $from->{versions} }) { |
| | 476 | next if exists $into->{versions}{$version}; |
| | 477 | $into->{versions}{$version} = $from->{versions}{$version}; |
| | 478 | delete $from->{versions}{$version}; |
| | 479 | $merges++; |
| | 480 | } |
| | 481 | if (scalar keys %{ $from->{versions} } == 0) { |
| | 482 | # only moveid left, so delete this row and redo to hit the next one |
| | 483 | splice @$lev_moves, $from_idx, 1; |
| | 484 | redo; |
| | 485 | } |
| | 486 | } |
| | 487 | } while ($merges); |
| | 488 | |