#!/usr/bin/perl -w # Copyright (C) 2008 Alex Schroeder # # This program is free software: you can redistribute it and/or modify it under # the terms of the GNU General Public License as published by the Free Software # Foundation, either version 3 of the License, or (at your option) any later # version. # # This program is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along with # this program. If not, see . use POSIX; # floor use Getopt::Std; my $verbose = 0; my $number = 10; my $level = undef; my $race = undef; my $class = undef; my $help = undef; my $fighterbonus = 4; my $statbonus = 4; sub level { return 1 + int(rand(6)); } sub roll3d6 { return 3 + int(rand(6)) + int(rand(6)) + int(rand(6)); } sub improve { my ($level, $class, $str, $dex, $mind) = @_; my $bonus = int($level/$statbonus); if ($bonus) { if ($class eq 'wizard') { $mind += $bonus; warn "increased mind by +$bonus\n" if $verbose; } elsif ($dex > $str) { $dex += $bonus; warn "increased dex by +$bonus\n" if $verbose; } else { $str += $bonus; warn "increased str by +$bonus\n" if $verbose; } } return ($str, $dex, $mind); } my @race = (['dwarf', +2, 0, 0], ['elf', 0, 0, +2], ['halfling', 0, +2, 0], ['human', 0, 0, 0]); sub race { my ($race, $str, $dex, $mind) = @_; warn "starting with $str, $dex, $mind\n" if $verbose; my $i; if ($race) { for ($i = 0; $i < $#race; $i++) { last if $race eq $race[$i][0]; } } else { $i = int(rand(4)); $race = $race[$i][0]; } if ($race eq 'human') { my $count = 0; if ($str % 2) { $count++; $str++; } if ($dex % 2) { $count++; $dex++; } if ($count < 2 and $mind % 2) { $count++; $mind++; } # If we had too few odd stats, put the rest on STR. $str += 2 - $count; } else { $str += $race[$i][1]; $dex += $race[$i][2]; $mind += $race[$i][3]; } warn "ending with $race, $str, $dex, $mind\n" if $verbose; return $race, $str, $dex, $mind; } my @class = ('fighter', 'wizard', 'cleric'); sub class { my ($str, $dex, $mind) = @_; my $class = 'cleric'; if ($mind > $str and $mind > $dex and ($mind >= 12)) { $class = 'wizard'; warn "picked wizard because of mind\n" if $verbose; } elsif ($str >= 12 and $dex >= 10 or $str >= 10 and $dex >= 12) { $class = 'fighter'; warn "picked fighter because of str or dex\n" if $verbose; } return $class; } sub twohanded { my $str = shift; return $str >= 16; } sub bonus { my $stat = shift; return floor(($stat - 10) / 2); } sub AC { my ($class, $str, $dex) = @_; my ($armor, $ac); if ($class eq 'wizard') { ($armor, $ac) = ('robe', '0'); } else { if ($dex >= 16) { ($armor, $ac) = ('leather', '2'); } if ($dex >= 14) { ($armor, $ac) = ('chainmail', '4'); } else { ($armor, $ac) = ('platemail', '6'); } if (not twohanded($str)) { $armor .= ' and shield'; $ac += 1; } } return $armor, 10 + $ac + bonus($dex); } sub HP { my ($str, $level) = @_; my $hp = $str; for (my $i = 1; $i <= $level; $i++) { $hp += 1 + int(rand(6)); warn "hp increased to $hp @ level $i\n" if $verbose; } return $hp; } sub weapon { my ($str, $dex, $class, $level, $race, $attack) = @_; my $ranged = ($dex > $str); my $damage = '1d6'; $attack += $ranged ? bonus($dex) : 0; my $bonus = $ranged ? 0 : bonus($str); $bonus *= 2 if twohanded($str); $bonus += 1 + int($level/$fighterbonus) if $class eq 'fighter'; if ($bonus) { $damage .= sprintf('%+d', $bonus); } if ($ranged) { my @weapon = ('light crossbow'); if ($class ne 'wizard' and $race ne 'dwarf') { push(@weapon, 'longbow'); } return $weapon[int(rand(scalar @weapon))], $attack, $damage; } elsif (twohanded($str)) { my @weapon = ('greatsword', 'greataxe', 'zweihander', 'longspear', 'greathammer', 'claymore', 'glaive'); return $weapon[int(rand(scalar @weapon))], $attack, $damage; } else { my @weapon = ('longsword', 'shortsword', 'warhammer', 'mace', 'rapier', 'axe'); return $weapon[int(rand(scalar @weapon))], $attack, $damage; } } sub attack { my ($class, $level) = @_; return ($class eq 'fighter' ? $level + 1 + int($level / $fighterbonus) : $level); } sub wrap { my ($str, $col) = @_; $col = 72 unless $col; $str =~ s/\b\s\s+/ /g; # trim whitespace $str =~ s/\s+$//g; # trim whitespace $str =~ /^( *(\d+\. )?)/; my $indent = length($1); my $start = $indent; my $end = length($str); while ($end - $start > $col) { my $i = $start + $col; $i-- while substr($str, $i, 1) ne ' ' and $i > $start; last if $i <= $start; # no space found $start = $i; $str = substr($str, 0, $i) . "\n" . (' ' x $indent) . substr($str, $i + 1); } return $str; } sub help { join("\n", "-v verbose output", "-h show help", "-n 3 (number) just print three characters", "-l 3 (level) just print level three characters", "-r elf (race) just print elven characters", "-c fighter (class) just print fighter characters") . "\n"; } sub text { my ($setlevel, $setrace, $setclass) = @_; die "Unknown race '$race'\n" if $setrace and not grep /^$setrace$/, map { $_->[0] } @race; die "Unknown class '$setclass'\n" if $setclass and not grep /^$setclass$/, @class; my @list; for (my $i=1; $i <= $number; $i++) { my $level = $setlevel || level(); my ($race, $str, $dex, $mind) = race($setrace, roll3d6, roll3d6, roll3d6); my $class = $setclass || class($str, $dex, $mind); ($str, $dex, $mind) = improve($level, $class, $str, $dex, $mind); my ($armor, $ac) = AC($class, $str, $dex); my $hp = HP($str, $level); my ($weapon, $attack, $damage) = weapon($str, $dex, $class, $level, $race, attack($class, $level)); my $description = ("$race $class $level HP $hp" . " STR $str DEX $dex MIND $mind" . " AC $ac ($armor)" . " +$attack $weapon ($damage)"); my $magic = $level + bonus($mind); $description .= " +$magic magic" if $class eq 'wizard'; push(@list, $description); warn "\n" if $verbose; } return @list; } sub plain { my $count = 0; for my $line (@_) { $count++; print wrap(sprintf('%3d. ', $count) . $line), "\n"; print "\n"; } } # first item is the title $title = 'M20 Hard Core Character Generation'; my @links = (['Source Code', '/source'], ['M20 Hard Core', 'http://www.emacswiki.org/alex/M20_Hard_Core'], ['M20', 'http://microlite20.net/'], ['M74', 'http://blog.retroroleplaying.com/2008/07/microlite74-released-download-your-copy.html']); sub html { require CGI; $q = new CGI; if ($q->path_info eq '/source') { print $q->header(-charset=>'utf-8', -type=>'text/plain'); seek DATA, 0, 0; print ; } else { print $q->header(-charset=>'utf-8'), $q->start_html($title); print $q->h1($title); print $q->ol(map { $q->li($_)} @_); print $q->p($q->a({-href=>$q->url}, 'More…')); print $q->hr, $q->p(join(' | ', map { my $target = $_->[1]; my $title = $_->[0]; $target = $q->url . $target unless $target =~ m|^[a-z]+://|; $q->a({-href=>$target}, $title); } @links)); print $q->end_html; } } sub main { my %opts; getopt('vhn:l:r:c:', \%opts); $verbose = exists $opts{'v'}; die help() if exists $opts{'h'}; $number = $opts{'n'} if $opts{'n'}; $level = $opts{'l'} if $opts{'l'}; $race = $opts{'r'} if $opts{'r'}; $class = $opts{'c'} if $opts{'c'}; if ($ENV{GATEWAY_INTERFACE}) { html(text()); } else { plain(text($level, $race, $class)); } } main (); __DATA__