Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Making XP Change

by diotalevi (Canon)
on Jun 09, 2005 at 18:30 UTC ( #465241=sourcecode: print w/replies, xml ) Need Help??
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

    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

    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
      Oh, sorry. Isn't this just the most excrebale code you've ever seen put out by someone supposedly competent? *wink*
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.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://465241]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (3)
As of 2020-11-26 19:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?