Category: PerlMonks Related Scripts
Author/Contact Info Anonymous. I wish.
Description:

It tells you how many XP you have until your next modular promotion. It also makes change. Here's some sample output.

XP = 16780
16780.00 initiates
839.00 novices, 0 to promotion
335.60 acolytes, 30 to promotion
167.80 scribes, 80 to promotion
83.90 monks, 180 to promotion
33.56 friars, 280 to promotion
16.78 abbots, 780 to promotion
10.49 bishops, 780 to promotion
7.30 pontiffs, 680 to promotion
5.59 saints, 1780 to promotion
5 saints, a bishop, scribe, acolyte, novice, and 10 initiates
 
BEGIN {
    my @levels = ( initiate => 1,
                   novice => 20,
                   acolyte => 50,
                   scribe => 100,
                   monk => 200,
                   friar => 500,
                   abbot => 1000,
                   bishop => 1600,
                   pontiff => 2300,
                   saint => 3000 );
    while ( @levels ) {
        my ( $level, $xp ) = splice @levels, 0, 2;
        eval "sub $level () { $xp }";
    }
}
$xp = 0 + shift;

printf
"XP = $xp
%0.2f initiates
%0.2f novices, %d to promotion
%0.2f acolytes, %d to promotion
%0.2f scribes, %d to promotion
%0.2f monks, %d to promotion
%0.2f friars, %d to promotion
%0.2f abbots, %d to promotion
%0.2f bishops, %d to promotion
%0.2f pontiffs, %d to promotion
%.02f saints, %d to promotion
",
$xp / initiate,
$xp / novice,  novice  - ( $xp % novice ),
$xp / acolyte, acolyte - ( $xp % acolyte ),
$xp / scribe,  scribe  - ( $xp % scribe ),
$xp / monk,    monk    - ( $xp % monk ),
$xp / friar,   friar   - ( $xp % friar ),
$xp / abbot,   abbot   - ( $xp % abbot ),
$xp / bishop,  bishop  - ( $xp % bishop ),
$xp / pontiff, pontiff - ( $xp % pontiff ),
$xp / saint,   saint   - ( $xp % saint );

# I wish this was lisp.
for ( qw( saint pontiff bishop abbot friar monk scribe acolyte novice 
+initiate ) ) {
    eval "if ( \$xp >= $_ ) { push \@change, int( \$xp / $_ ) . \" ${_
+}s\";
                              \$xp %= $_ }";
}
for ( @change ) {
    if ( 1 == $_ ) {
        s/s$//;
    }
}

$_ = join( ', ', @change, ) . "\n";
# Replaced w/ NinthWave's code. No, I didn't read it first.
s<(?:^|\D)(1 [a-z]+(?:, 1 [a-z]+)*)>{
    my @ranks = $1 =~ /[a-z]+/g;
    " a " . join ', ', @ranks;
}ge;
s/^ //;
if ( /,.+,/ ) {
    s/(.+),([^,]+)/$1, and$2/;
}
print
Replies are listed 'Best First'.
Re: Making XP Change
by Paladin (Vicar) on Jun 09, 2005 at 21:04 UTC
    Heh.. this is great. One small bug fix needed though: 
    $ perl xp_o.pl 2731
XP = 2731
2731.00 initiates
136.55 novices, 11 to promotion
54.62 acolytes, 31 to promotion
27.31 scribes, 31 to promotion
13.65 monks, 131 to promotion
5.46 friars, 231 to promotion
2.73 abbots, 731 to promotion
1.71 bishops, 1131 to promotion
1.19 pontiffs, 431 to promotion
0.91 saints, 2731 to promotion
a pontiff, 2 monks, a novice, and 1a initiates

    [download]

    Note the "1a initiates". It should be 11. Replace the final bit with: 

    s<(?:^|\D)(1 [a-z]+(?:, 1 [a-z]+)*)>{
    my @ranks = $1 =~ /[a-z]+/g;
    " a " . join( ', ', @ranks )
}ge;
s/^ //;
if ( /,.+,/ ) {
    s/(.+),([^,]+)/$1, and$2/;
}
print

    [download]

    Which gives: 

    $ perl xp.pl 2731
XP = 2731
2731.00 initiates
136.55 novices, 11 to promotion
54.62 acolytes, 31 to promotion
27.31 scribes, 31 to promotion
13.65 monks, 131 to promotion
5.46 friars, 231 to promotion
2.73 abbots, 731 to promotion
1.71 bishops, 1131 to promotion
1.19 pontiffs, 431 to promotion
0.91 saints, 2731 to promotion
a pontiff, 2 monks, a novice, and 11 initiates

    [download]
[reply]
[d/l]
[select]
      Oh, sorry. Isn't this just the most excrebale code you've ever seen put out by someone supposedly competent? *wink*
[reply]
Re: Making XP Change
by ambrus (Abbot) on Jun 10, 2005 at 16:53 UTC

    Wow! I like this code, even though it took me some time to understand what it does.

    And great it doesn't print that I'm 0.00530 vrooms.

[reply]

Back to Code Catacombs