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;
}

[c0ncrete]

I ran into some strange issues with the previous iteration, and then I learned a new-to-me thing and reworked Absor.
The $forged_item hashref has multiple keys being assigned a shared value via $set_val.
That little coderef does a hell of a lot more than it may appear at first glance...
If that's not black magic, I don't know what is.

use strict;
use warnings;

use 5.12.3;

no warnings 'experimental::autoderef';

our ($npc, $name, %itemcount, $text, $class);

use constant {
    # dagger
    DAGGER => 9997,
    SHARPENED_DAGGER => 59950,
    # short sword
    SHORT_SWORD => 9998,
    SHARPENED_SHORT_SWORD => 59951,
    # club
    CLUB => 9999,
    POLISHED_CLUB => 59952,
    # axe
    DULL_AXE => 55623,
    SHARPENED_AXE => 55623,
    # material & weapons
    CHUNK_OF_BRONZE => 54229,
    BRONZE_GLOOMINGDEEP_DAGGER => 54230,
    BRONZE_GLOOMINGDEEP_SWORD => 54231,
    BRONZE_GLOOMINGDEEP_MACE => 54232,
    BRONZE_GLOOMINGDEEP_AXE => 54233,
    # material & weapons
    CHUNK_OF_IRON => 59954,
    IRON_GLOOMINGDEEP_DAGGER => 54235,
    IRON_GLOOMINGDEEP_SWORD => 54236,
    IRON_GLOOMINGDEEP_MACE => 54237,
    IRON_GLOOMINGDEEP_AXE => 54238
};

sub EVENT_SAY {
    # if $text stars with "hail" (case insensitive), do this ...
    if ($text =~ /^hail/i) {
        quest::say(
            "Hello $name. Before the slave revolt, I was forging picks and sh".
            "ovels. Now I'm making weapons so we can fight back. Mainly sword".
            "s and spears. Simple stuff. If you give me your weapon, I can ma".
            "ke you a better one!"
        );
        quest::updatetaskactivity(22, 1);
        quest::popup(
            "Weapons", "Absor is a weapon maker. You should already have a we".
            "apon equiped from your escape with Arias, but Absor can make it ".
            "better. Open your inventory and remove your weapon from the lowe".
            "r left slot. This is your primary weapon slot where you hold wea".
            "pons that you are currently using.<br><br><c \"#F07F00\">Give yo".
            "ur weapon to Absor to continue.</c>"
        );
    }
}

# accepts array or array ref as pool to summon single item from
sub summon_from_pool {
    my @pool = ( ref $_[0] ) =~ /array/i ? @{ +shift } : @_;
    quest::summonitem( $pool[ int rand (scalar @pool) ] );
};

# setting shared value for multiple keys in a hash
my $set_val = sub { map { $_ => $_[1] } @{ $_[0] }; };

# table defining items to be forged based on class and material
my $forged_item = {
    # these classes get a dagger, sword, or mace
    [ qw(Warrior Bard Rogue Ranger Shadowknight) ]->$set_val(
        [
            [BRONZE_GLOOMINGDEEP_DAGGER .. BRONZE_GLOOMINGDEEP_MACE],
            [IRON_GLOOMINGDEEP_DAGGER .. IRON_GLOOMINGDEEP_MACE],
        ]
    ),
    # these classes get a mace
    [ qw(Monk Druid Cleric Shaman) ]->$set_val(
        [
            [BRONZE_GLOOMINGDEEP_MACE],
            [IRON_GLOOMINGDEEP_MACE],
        ]
    ),
    # these classes get a dagger
    [ qw(Wizard Magician Enchanter Necromancer) ]->$set_val(
        [
            [BRONZE_GLOOMINGDEEP_DAGGER],
            [IRON_GLOOMINGDEEP_DAGGER],
        ]
    ),
    # paladins get a sword or a mace
    'Paladin' => [
        [BRONZE_GLOOMINGDEEP_SWORD, BRONZE_GLOOMINGDEEP_MACE],
        [IRON_GLOOMINGDEEP_SWORD, IRON_GLOOMINGDEEP_MACE],
    ],
    # beastlords get a dagger or a mace
    'Beastlord' => [
        [BRONZE_GLOOMINGDEEP_DAGGER, BRONZE_GLOOMINGDEEP_MACE],
        [IRON_GLOOMINGDEEP_DAGGER, IRON_GLOOMINGDEEP_MACE],
    ],
    # berserkers get an axe
    'Berserker' => [
        [BRONZE_GLOOMINGDEEP_AXE],
        [IRON_GLOOMINGDEEP_AXE],
    ]
};

# alias for check_handin that makes more sense below
# useage: given_items($itemid, $count)
sub given_items {
    plugin::check_handin( plugin::var('itemcount'), @_ );
}

# actions to take when an item is being repaired by Absor
sub return_repaired {
    quest::summonitem(shift);
    quest::emote(
        " takes the weapon from you and begins to polish and balance it. When".
        " he hands it back to you, it scarcely resembles the decayed old thin".
        "g that you were using."
    );
    quest::say("There you go. That should work much better.");
    quest::popup(
        'Weapons', 'Absor has fixed up your weapon and placed it back in your'.
        ' inventory. Pick up the improved weapon in your inventory and drop i'.
        't on the rectangular icon in the middle of your inventory window. Th'.
        'is will auto-equip the weapon back in your primary slot.<br><br><c "'.
        '#FFFF00">Open your Quest Window [ALT+Q] to check the next step in yo'.
        'ur Basic Training.</c><br><br><c "#F07F00">Hint: Use the find comman'.
        'd (CTRL+F) to find the next npc for your basic training.</c>'
    );
}

# actions to take when a new weapon is being forged by Absor
sub forge_weapon {
    # these variables control everything
    my ( $class, $material ) = ( $_[0]->{for}, $_[0]->{from} );
    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!"
    ) );
    # summons a random item from provided list
    summon_from_pool( $forged_item->{$class}->[$value] );
}

# chained ternary operations in lieu of if & elsif
sub EVENT_ITEM {
    # Absor will hone an existing weapon in these cases
    given_items(DAGGER, 1) ?
        return_repaired(SHARPENED_DAGGER)
    : given_items(SHORT_SWORD, 1) ?
        return_repaired(SHARPENED_SHORT_SWORD)
    : given_items(CLUB, 1) ?
        return_repaired(POLISHED_CLUB)
    : given_items(DULL_AXE, 1) ?
        return_repaired(SHARPENED_AXE)
    # Absor will forge a new weapon in these cases
    : given_items(CHUNK_OF_BRONZE, 1) ?
        forge_weapon( {'for' => $class, 'from' => CHUNK_OF_BRONZE} )
    : given_items(CHUNK_OF_IRON, 1) ?
        forge_weapon( {'for' => $class, 'from' => CHUNK_OF_IRON} )
    # default action is to do nothing
    : undef;
    # return unused stuff
    plugin::return_items(\%itemcount);
}

EDIT: kinglykrab reminded me I need a proofreader...