dispatch tables, by example (Absor)

[c0ncrete]

Was puttering around with ideas to clean up Absor (repetition & lots of if/elsif statements) in tutorialb in the wee hours, and this is the result. It's not the entirety of the script, but it is most of it. I left out the simpler bits and commented everything in order to make the logic easier to follow.

NOTE: This, and most other code, is orders of magnitude easier to read with proper syntax highlighting. Do yourself a favor and take advantage of it, even if you're using vim.

use constant {
    DAGGER => 9997,
        SHARPENED_DAGGER => 59950,
    SHORT_SWORD => 9998,
        SHARPENED_SHORT_SWORD => 59951,
    CLUB => 9999,
        POLISHED_CLUB => 59925,
    DULL_AXE => 55623,
        SHARPENED_AXE => 55623,
    CHUNK_OF_BRONZE => 54229,
        BRONZE_GLOOMINGDEEP_DAGGER => 54230,
        BRONZE_GLOOMINGDEEP_SWORD => 54231,
        BRONZE_GLOOMINGDEEP_MACE => 54232,
        BRONZE_GLOOMINGDEEP_AXE => 54233,
    CHUNK_OF_IRON => 59954,
        IRON_GLOOMINGDEEP_DAGGER => 54235,
        IRON_GLOOMINGDEEP_SWORD => 54236,
        IRON_GLOOMINGDEEP_MACE => 54237,
        IRON_GLOOMINGDEEP_AXE => 54238
};

# works like quest::summonitem(quest::chooserandom())
my $summon_from = sub {
    # accepts array or array ref as pool to select randomly from
    my @pool = ( ref $_[0] ) =~ /array/i ? @{ +shift } : @_;
    quest::summonitem( $pool[ int ( rand ( scalar @pool ) ) ] );
    # required because summonitem method returns nothing
    return 1;
};

# select item from pool based on player class and turn-in material value
my $forge_weapon = sub {
    my ( $class, $value ) = @_;
    # ! WARNING: see warning below about short circuiting ...
    # iterate over anon hash (dispatch table)
    while ( my ( $archetype, $reward_pool ) = each {
         # key ($archetype) is a simple regex to match against $class
        'warr|rang|shad|bard|rogu' => [
            # val 0 ($reward_pool->[0]) is reward list for bronze chunk
            [BRONZE_GLOOMINGDEEP_DAGGER..BRONZE_GLOOMINGDEEP_MACE],
            # val 1 ($reward_pool->[1]) is reward list for iron chunk
            [IRON_GLOOMINGDEEP_DAGGER..IRON_GLOOMINGDEEP_MACE],
        ],
        'cler|drui|monk|sham' => [
            [BRONZE_GLOOMINGDEEP_MACE],
            [IRON_GLOOMINGDEEP_MACE],
        ],
        'necr|wiza|magi|ench' => [
            [BRONZE_GLOOMINGDEEP_DAGGER],
            [IRON_GLOOMINGDEEP_DAGGER],
        ],
        'pala' => [
            [BRONZE_GLOOMINGDEEP_SWORD, BRONZE_GLOOMINGDEEP_MACE],
            [IRON_GLOOMINGDEEP_SWORD, IRON_GLOOMINGDEEP_MACE],
        ],
        'beas' => [
            [BRONZE_GLOOMINGDEEP_DAGGER, BRONZE_GLOOMINGDEEP_MACE],
            [IRON_GLOOMINGDEEP_DAGGER, IRON_GLOOMINGDEEP_MACE],
        ],
        'berz' => [
            [BRONZE_GLOOMINGDEEP_AXE],
            [IRON_GLOOMINGDEEP_AXE],
        ]
    # returns on first archetype match and successful item summon
    } ) { return 1 if $class =~ /$archetype/i && $summon_from->( $reward_pool->[$value] ) }
}

# grouping stuff this way helps with abstraction
my $forged_weapon_for = sub {
    # these variables control everything
    my ( $class, $material ) = @_;
    my $value = ( $material == CHUNK_OF_IRON );
    # single-line, dynamic quest::say example
    quest::say("Now let me see... Ah ha! Here ya go! ".(
      # ternary op controls which additional text is used
      $value
        # first is for chunk of iron turnin
        ? "A spiffy, new weapon to aid you in your adventures!"
        # second is for chunk of bronze turnin
        : "A much better weapon to help fend off those nasties!"
    ));
    # call dispatch table for weapon forging
    return $forge_weapon->($class, $value);
};

# everything in the event is clearly defined elsewhere in the script
# this makes it easier to have an overview of what the event does
sub EVENT_ITEM {
    # ! WARNING: make sure you have a path to short circuit ...
    # we define a list of trigger => responses pairs here
    while ( my ($condition_met, $action_taken) = each {
        # scenario group: improve existing weapon
        $accepted_broken->(DAGGER)      => $returned_repaired->(SHARPENED_DAGGER),
        $accepted_broken->(SHORT_SWORD) => $returned_repaired->(SHARPENED_SHORT_SWORD),
        $accepted_broken->(CLUB)        => $returned_repaired->(POLISHED_CLUB),
        $accepted_broken->(DULL_AXE)    => $returned_repaired->(SHARPENED_AXE),
        # scenario group: forge new weapon
        $accepted_metal->(CHUNK_OF_BRONZE) => $forged_weapon_for->($class, CHUNK_OF_BRONZE),
        $accepted_metal->(CHUNK_OF_IRON)   => $forged_weapon_for->($class, CHUNK_OF_IRON)
    # short circuit on first instance of condition_met AND return of 1 from action_taken
    } ) { last if $condition_met && $action_taken } # ! ... or loop forever!
    # return what we didn't use
    $return_unused_stuff;
}