#!/usr/bin/perl -w

use strict qw(vars);
use Getopt::Std;

use vars qw($opt_d $opt_h);
getopts('dh');

#
# -d flag enables debugging output.
#
if ($opt_d) {
	select STDERR; $| = 1;
	select STDOUT; $| = 1;
}


#
# Sample code block:
#
# -----BEGIN REDBRICK CODE BLOCK-----
# Version 1.0
#
# Rb(CA) d s+:+ hBRZ3S a18:--- Is p+++
# n1 pn+ B+ WAW sl+ Eel[h] w+++ DCU*
# Anun L--- F++ Cs---td#[2]!td V---
# ------END REDBRICK CODE BLOCK------
#
# Output sections (%code):
# self:	age, hair, size, course, dress
# rb:	BBS, notoriety, persona, presence, socials, newsgroups
# dcu:	CSD, DCU, authority, union, lectures, frodos
# comp:	VAX, email, web, interface
# misc:	KidIc, Slakers, Warhammer
#

if ($opt_h) {

	print <<END;
Usage:        $0 [-d] [-h] [file file ...]

Options:      -d           Enable debugging output
              -h           Print this help

Description:  This is a RedBrick Code decoder. Supply a valid(-ish)
              RedBrick code, either in the file(s) named on the command
              line or on stdin, and it will print whatever it can
              make of it. The RedBrick Code can be found at:
                  http://www.redbrick.dcu.ie/~wishkah/code.html

Copyright (c) 2002 James Raftery. All rights reserved. This program is
free software; you can redistribute it and/or modify it under the same
terms as Perl itself.

James Raftery <lecter\@redbrick.dcu.ie>
2nd May 2002.
END

	exit;
}


my %code;
my @funcs = qw(WAW DCU So sl Ng Rb Ki Cs pn E h a B V s d n p I w A L F);

my($key, $attr, $begin);
while (<>) {

	if (/^\s*-+BEGIN REDBRICK CODE BLOCK-+\s*$/i) {
		$begin = 1;
		#&showcode;
		next;
	}

	if (/^\s*-+END REDBRICK CODE BLOCK-+\s*$/i) {
		&showcode if $begin;
		$begin = 0;
		next;
	}

	next unless $begin;
	next if /^\s*Version.*$/;
	next if /^\s*$/;

	ATTR: foreach $attr (split) {

		print ">> Examining '$attr'\n" if $opt_d;

		foreach $key (@funcs) {

			print "\tTesting against '$key'\n" if $opt_d;
			if ($attr =~ s/^$key//) {

				print "\t> Go '$key' with '$attr'\n" if $opt_d;
				&$key($attr);
				next ATTR;
			}
		}

		print "\tTesting for 'bang'\n" if $opt_d;
		if ($attr =~ s/^\!//) {
			print "\t> Run '&bang' with '$attr'\n" if $opt_d;
			&bang($attr);
			next ATTR;

		}

		print "\tRunning '&static'\n" if $opt_d;
		next ATTR if &static($attr);

		print STDERR "Bad token: $attr (bad, bad token)\n";
	}
}

&showcode if $begin;
exit;

#######################################################################

sub showcode {
	my $width = 72;

	if ($code{self}) {
		print "=== A little about myself " . "="x46 . "\n";
		$code{self} =~ s/^ //;
		&wrap($width, \$code{self});
		print $code{self} . "\n\n";
	}

	if ($code{rb}) {
		print "=== My RedBrick " . "="x56 . "\n";
		$code{rb} =~ s/^ //;
		&wrap($width, \$code{rb});
		print $code{rb} . "\n\n";
	}

	if ($code{dcu}) {
		print "=== What I think of DCU " . "="x48 . "\n";
		$code{dcu} =~ s/^ //;
		&wrap($width, \$code{dcu});
		print $code{dcu} . "\n\n";
	}

	if ($code{comp}) {
		print "=== Me and computers " . "="x51 . "\n";
		$code{comp} =~ s/^ //;
		&wrap($width, \$code{comp});
		print $code{comp} . "\n\n";
	}

	if ($code{misc}) {
		print "=== Everything else " . "="x52 . "\n";
		$code{misc} =~ s/^ //;
		&wrap($width, \$code{misc});
		print $code{misc} . "\n\n";
	}

	%code = ();
}

sub static {

	$_ = shift;

	my %desc = (
		'XWAW'	=> [ ("misc"," I'm a reformed Warhammer player. I've seen the error of my ways and given up.") ],
		'?V'	=> [ ("comp"," I'm pre-fourth-year. What's VAX?") ],
	);

	if ($desc{$_}) {
		print "\t> Found '&static' for '$_'\n" if $opt_d;
		$code{$desc{$_}[0]} .= $desc{$_}[1];
		return 1;
	}

	return 0;
}

sub bang {
	# Bang (!) preceeded tokens.

	$_ = shift;

	SWITCH: {

		if ($_ eq "B")		{ $code{rb} .= " I am a sysadmin, and responsible for forcing my own news-and-chat tastes upon you mere mortals."; last SWITCH; }

		if ($_ eq "a")		{ $code{self} .= " It's none of your business how old I am."; last SWITCH; }

		if ($_ eq "I")		{ $code{comp} .= " I have become one with my computer. It is a feeling of ecstasy... the perfect blend of logic and emotion."; last SWITCH; }

		if ($_ eq "DCU")	{ $code{dcu} .= " I don't know what DCU is?!"; last SWITCH; }

		if ($_ eq "d")		{ $code{self} .= " No clothes - Clothes are an illusion. Mine doubly so...Quite a fashion statement, don't you think?"; last SWITCH; }

		if ($_ eq "n")		{ $code{rb} .= " Complete strangers, even ones not on RedBrick, come up to me and identify me by my username."; last SWITCH; }

		if ($_ eq "png")	{ $code{rb} .= " Gender Confusion. User-name suggests user is a member of opposite sex."; last SWITCH; }

		if ($_ eq "p")		{ $code{rb} .= " I am Avatar. I may log in 3 times a day, but I don't have to like it. Keyword: Screwed up!"; last SWITCH; }

		if ($_ eq "sl")		{ $code{misc} .= " They won't let me join the S.L.A.K.E.R.S :-("; last SWITCH; }

		if ($_ eq "F")		{ $code{dcu} .= " I don't drink."; last SWITCH; }

		if ($_ eq "F+")		{ $code{dcu} .= " I don't drink, but I go there anyway."; last SWITCH; }

		if ($_ eq "F-")		{ $code{dcu} .= " I don't drink, and even if I did, Frodo's *spit* would be the last place I'd go..."; last SWITCH; }

		if ($_ eq "So")		{ $code{rb} .= " I am Kod, and nothing happens in this town without my say-so."; last SWITCH; }

		print STDERR "Bad token: (bang)$_ (bad, bad token)\n";

	}

	# print "\n";
}

sub a {
	# Parse out 'a' blocks - age.

	my($m, $age);
	($_,$m) = split(/:m/, shift);

	my %ages = (
		null	=> "30 - 39 years old",
		"+++++"	=> "80 years old (or more)",
		"++++"	=> "70 - 79 years old",
		"+++"	=> "60 - 69 years old",
		"++"	=> "50 - 59 years old",
		"+"	=> "40 - 49 years old",
		"-"	=> "25 - 29 years old",
		"--"	=> "20 - 24 years old",
		"---"	=> "15 - 19 years old",
		"----"	=> "10 - 14 years old",
		"-----"	=> "9 years old (or less)",
		"?"	=> "immortal",
	);

	SWITCH: {
		# Blank
		if (!$_)		{ $age = $ages{null}; last SWITCH; }
		# Only digits
		if (/^\d+$/)		{ $age = "$_ years old"; last SWITCH; }
		# Pluses, minuses or "?"
		if (/^[+-]{1,5}$/ || /^\?$/) { $age = $ages{$_}; last SWITCH; }

		$age = "<sssh> years old";
	}

	$code{self} .= " I am $age.";

	my $conjunction;
	SWITCH: {
		last SWITCH unless $m;

		$conjunction = ($_ eq $m) ? "and" : "but";
		$_ = $m;

		if (!$_)		{ $age = $ages{null}; last SWITCH; }
		if (/^\d+$/)		{ $age = "$_ years old"; last SWITCH; }
		if (/^[+-]{1,5}$/ || /^\?$/) { $age = $ages{$_}; last SWITCH; }

		$age = "(preschool?)";
	}

	$code{self} .= "..$conjunction mentally I'm $age." if $m;

	# $code{self} .= "\n";
}

sub h {
	# Parse out 'h' blocks - hair.

	$_ = shift;

	$code{self} .= " My hair is";

	# Colour
	SWITCH: {

		if (s/^DBR//)	{ $code{self} .= " dark brown"; last SWITCH; }
		if (s/^LBR//)	{ $code{self} .= " light brown"; last SWITCH; }
		if (s/^PTb//)	{ $code{self} .= " PTork blonde"; last SWITCH; }
		if (s/^BK//)	{ $code{self} .= " black"; last SWITCH; }
		if (s/^WB//)	{ $code{self} .= " white blonde"; last SWITCH; }
		if (s/^LB//)	{ $code{self} .= " light blonde"; last SWITCH; }
		if (s/^SB//)	{ $code{self} .= " strawberry blonde"; last SWITCH; }
		if (s/^BR//)	{ $code{self} .= " brown"; last SWITCH; }
		if (s/^GR//)	{ $code{self} .= " grey"; last SWITCH; }
		if (s/^MC//)	{ $code{self} .= " multicoloured"; last SWITCH; }
		if (s/^BU//)	{ $code{self} .= " blue"; last SWITCH; }
		if (s/^PI//)	{ $code{self} .= " pink"; last SWITCH; }
		if (s/^NR//)	{ $code{self} .= " natural red (not like a fire engine)"; last SWITCH; }
		if (s/^R//)	{ $code{self} .= " red (like a fire engine)"; last SWITCH; }
		if (s/^G//)	{ $code{self} .= " green"; last SWITCH; }
		if (s/^O//)	{ $code{self} .= " orange"; last SWITCH; }
		if (s/^P//)	{ $code{self} .= " purple"; last SWITCH; }
		if (s/^Z//)	{ $code{self} .= " some wierd ass colour"; last SWITCH; }
		if (s/^B//)	{ $code{self} .= " blonde"; last SWITCH; }

		$code{self} .= " uncoloured(?)";
	}

	# Style
	# Scan through until we reach the length (i.e. a number) for those
	# awkward people who sue more than one style.
	WHILE: while ($_ && !/^\d/) {
		if (s/^b//)	{ $code{self} .= ", bald"; next WHILE; }
		if (s/^c//)	{ $code{self} .= " and curly"; next WHILE; }
		if (s/^f//)	{ $code{self} .= ", with a flattop"; next WHILE; }
		if (s/^k//)	{ $code{self} .= " and crimped"; next WHILE; }
		if (s/^s//)	{ $code{self} .= " and straight"; next WHILE; }
		if (s/^m//)	{ $code{self} .= ", in a mohawk"; next WHILE; }
		if (s/^p//)	{ $code{self} .= ", in a ponytail"; next WHILE; }
		if (s/^w//)	{ $code{self} .= " and wavy"; next WHILE; }
		if (s/^q//)	{ $code{self} .= ", in a quiff"; next WHILE; }
		if (s/^d//)	{ $code{self} .= ", in drealocks"; next WHILE; }
		if (s/^Y//)	{ $code{self} .= ", in some wierd ass style"; next WHILE; }
		if (s/^Z//)	{ $code{self} .= " and though I'd love a style they never seem to work"; next WHILE; }

		$code{self} .= " and without style, apparently";
		last WHILE;
	}

	$code{self} .= ".";

	# Length
	SWITCH: {
		if (s/^1//)	{ $code{self} .= " It's bald/no 1,2,3."; last SWITCH; }
		if (s/^2//)	{ $code{self} .= " It's short cropped."; last SWITCH; }
		if (s/^3//)	{ $code{self} .= " It's a 'short back and sides' affair."; last SWITCH; }
		if (s/^4//)	{ $code{self} .= " It's chin length."; last SWITCH; }
		if (s/^5//)	{ $code{self} .= " It's a kind of in between length."; last SWITCH; }
		if (s/^6//)	{ $code{self} .= " It's at that irritating length where the front gets in your eyes and the back looks particularly dickie in the centre of your neck."; last SWITCH; }
		if (s/^7//)	{ $code{self} .= " It's shoulder length."; last SWITCH; }
		if (s/^8//)	{ $code{self} .= " It's at the small of my back."; last SWITCH; }
		if (s/^9//)	{ $code{self} .= " It's at my bum."; last SWITCH; }

		$code{self} .= " I'm not saying how long it is.";
	}

	# Face hair
	# There can be many of these. Keep going until we use up the entire
	# string or hit a bad character. Oh, and insult the coder too.
	WHILE: while ($_) {

		if (s/^B//)	{ $code{self} .= " Add a beard."; next WHILE; }
		if (s/^G//)	{ $code{self} .= " Add a goatee."; next WHILE; }
		if (s/^M//)	{ $code{self} .= " Add a moustache."; next WHILE; }
		if (s/^L//)	{ $code{self} .= " Add a strange bit of bum-fluff that you get just above your beard, below your lower lip."; next WHILE; }
		if (s/^S//)	{ $code{self} .= " It's not that I'm growing a beard, more I don't have time to shave..."; next WHILE; }

		$code{self} .= " I've got summat else strange on my face.";
		last WHILE;
	}

	#$code{self} .= ".";
}

sub B {
	# BBS

	$_ = shift;

	SWITCH: {

		if (!$_)		{ $code{rb} .= " Things change, I adapt, that's the way life goes. BBS vs. news is six of one, half a dozen of the other..."; last SWITCH; }

		if ($_ eq "++")		{ $code{rb} .= " The BBS was wonderful. News boards, Chat, finger, and internal email (for a while, anyway) all in one neat, easy-to-use package. A pox on those fascist sysadmins."; last SWITCH; }

		if ($_ eq "+")		{ $code{rb} .= " I liked the BBS. It was way easier to use than this slrn lark. I miss /a and jumbled threads and being able to make sense of things using MS Telnet."; last SWITCH; }

		if ($_ eq "-")		{ $code{rb} .= " Hey, this news is nice. Colours! Threads! Cross-posting! And I'll never have to read another of Spike's postings on BBS again!"; last SWITCH; }

		if ($_ eq "--")		{ $code{rb} .= " YES!! At LAST!! This news thing is *soooooo* much better than BBS. I wonder if the sysadmins will be collecting on those sexual favours I offered them now?"; last SWITCH; }

		if ($_ eq "?")		{ $code{rb} .= " I'm pre-third-year. I only know news. What's BBS"; last SWITCH; }

		$code{rb} .= " Can't work out BBS";

	}

	# $code{rb} .= "\n";
}

sub Ki {
	# Kid Icarus

	$_ = shift;

	SWITCH: {
		if (!$_)		{ $code{misc} .= " Seen Kid Icarus once or twice. Not bad, are they?"; last SWITCH; }

		if ($_ eq "+++")	{ $code{misc} .= " I'm a Kid (Icarus). I'm either Soma, Spock, Morgan, or The Other One."; last SWITCH; }

		if ($_ eq "++")		{ $code{misc} .= " I'm a fanatic Kid Icarus groupie. Been to all the gigs, know all the lyrics, have copies of all the bootleg recordings, fantasize about one day marrying Spock."; last SWITCH; }

		if ($_ eq "+")		{ $code{misc} .= " Been to most of the Kid Icarus gigs, anxiously awaiting a CD I can buy. They're grrrrrreat!"; last SWITCH; }

		if ($_ eq "-")		{ $code{misc} .= " Kid Icarus just aren't catchy enough. They should strive to be a bit more like Oasis/The Verve."; last SWITCH; }

		if ($_ eq "--")		{ $code{misc} .= " Kid Icarus are bland, unoriginal, uninspired. I like using words like that because then some people think I know what I'm talking about."; last SWITCH; }

		if ($_ eq "---")	{ $code{misc} .= " Kid Icarus are chronic. No sense of rhythm, guitars distorted to cover lack of talent, annoying nasal singing. Excuse me now, must rush off and watch Top 30 Hits."; last SWITCH; }

		if ($_ eq "#")		{ $code{misc} .= " Hi, I'm Ado."; last SWITCH; }

		if ($_ eq "?")		{ $code{misc} .= " Kid Icarus? Kid Who?"; last SWITCH; }

		$code{misc} .= " Can't work out KidIc-ness";
	}

	#$code{misc} .= "\n";
}

sub Cs {
	# CSD

	$a = shift;
	$_ = $a;
	s/\!?td.*$//;

	# Opinion of CSD
	SWITCH: {
		if (!$_)		{ $code{dcu} .= " Computer Services are STRICT alright."; last SWITCH; }

		if ($_ eq "+++")	{ $code{dcu} .= " Computer Services in DCU are the Prophets of the New God. Their arduous task is made more difficult by the irrelevant questions of ignorant students. I work for them."; last SWITCH; }

		if ($_ eq "++")		{ $code{dcu} .= " Computer Services are a wonderful bunch of helpful, good natured souls whose only joy in life is to help us, the students. I feel it's right, and just, that permissions are withdrawn one-by-one from every program on tolka because of the strain placed on the system by people actually using it."; last SWITCH; }

		if ($_ eq "+")		{ $code{dcu} .= " Computer Services are doing OK. They have a lot to do and try hard to accomodate the needs of the students."; last SWITCH; }

		if ($_ eq "-")		{ $code{dcu} .= " Computer Services are bad, but no worse."; last SWITCH; }

		if ($_ eq "--")		{ $code{dcu} .= " Computer Services are total tossers who deserve a collective swift kick in the arse and a P45 so that folks who know what they're doing can get on and make something of the pretty decent computing facilities we have here."; last SWITCH; }

		if ($_ eq "---")	{ $code{dcu} .= " Computer Services are the fowl spawn of Satan's Little Helpers and Barney. Their competence can be measured in microns. They suck. They're scum. They're not worthy etc. etc."; last SWITCH; }

		$code{dcu} .= " Can't work out CSD";

	}

	$_ = $a;
	s/[+-]+//;

	# tolka
	if (s/\!td//)		{ $code{dcu} .= " I should have been disusered but never got caught. Kewl!"; }
	if (s/td\[(\d+)\]//)	{ $code{dcu} .= " I've been disusered $1 times."; }
	if (s/td#\[(\d+)\]//)	{ $code{dcu} .= " I've gotten someone else disusered $1 times."; }

	# $code{dcu} .= "\n";
}

sub V {
	# Your VAXness

	$_ = shift;

	SWITCH: {
		if (!$_)		{ $code{comp} .= " Eh, is the new one any different from VAX? I dunno, I never used it anyway."; last SWITCH; }

		if ($_ eq "+++")	{ $code{comp} .= " I have a shrine to VAX in my bedroom. I loved it. God how I miss her. The touch of the keyboard...the little 'beep' when you got new mail....I miss you so much, baby.....*sniff*"; last SWITCH; }
		if ($_ eq "++")		{ $code{comp} .= " I used VAX quite a bit, and I do miss it. Still, I guess we have RedBrick now. Dammit ! What's the unix for 'DIR /NEW'????"; last SWITCH; }
		if ($_ eq "+")		{ $code{comp} .= " I used VAX a bit. Still, I guess we have tolka now."; last SWITCH; }
		if ($_ eq "-")		{ $code{comp} .= " Hahahah. VAX is gone!! Unix Rules!"; last SWITCH; }
		if ($_ eq "--")		{ $code{comp} .= " YES!YES! My prayers have been answered...the VAX is gone and DCU has a Unix server! Hey look! I've just spawned a process!! Hahahahah."; last SWITCH; }
		if ($_ eq "---")	{ $code{comp} .= " Ding Dong! The VAX is gone! God how I hated that thing. Now we have a real computer! Now I can take down my VAX dartboard!! Yipee!!"; last SWITCH; }

		$code{comp} .= " Can't work out VAXness.";

	}

	#$code{comp} .= "\n";

}

sub Rb {
	# Your course

	$_ = shift;

	unless (s/\((.*)\)/$1/) {
		$code{self} .= " Can't work out your course. Let me guess. BS?";
		return;
	}

	SWITCH: {

		if (/^do(.*)$/)		{ $code{self} .= " I dropped out of $1."; last SWITCH; }
		if (/^gr(.*)$/)		{ $code{self} .= " I've graduated out of $1."; last SWITCH; }

		if ($_ eq "OS")		{ $code{self} .= " I'm an outsider (oooh)."; last SWITCH; }
		if ($_ eq "NI")		{ $code{self} .= " I'm not in college."; last SWITCH; }

		&addarticle(\$_);
		$code{self} .= " I'm $_.";
	}

	#$code{self} .= "\n";

}

sub addarticle {
	# Prepend the appropriate indefinite article to the string in the
	# scaler reference.

	my $noun = shift;
	if (/^[aeiou]/i) {
		$$noun = "an $$noun";
	} else {
		$$noun = "a $$noun";
	}
}

sub s {
	# Size

	my($h,$w) = split(/:/, shift);

	SWITCH: {

		if (!$h && !$w)			{ $code{self} .= " Wahey! I do be normal in the height and weight department."; last SWITCH; }

		HEIGHT: {

			if (!$h)		{ $code{self} .= " I be normal heighted (ooh-arr)"; last HEIGHT; }

			if ($h eq "+++")	{ $code{self} .= " I usually have to duck through doors"; last HEIGHT; }
			if ($h eq "++")		{ $code{self} .= " I loom"; last HEIGHT; }
			if ($h eq "+")		{ $code{self} .= " I'm a little taller than average"; last HEIGHT; }
			if ($h eq "-")		{ $code{self} .= " I look up to most people"; last HEIGHT; }
			if ($h eq "--")		{ $code{self} .= " I'm X foot nothing"; last HEIGHT; }
			if ($h eq "---")	{ $code{self} .= " Okay, so I'm small (I can still headbutt your groin)"; last HEIGHT; }

			$code{self} .= " My height is garbled";
		}

		WEIGHT: {

			if (!$w)		{ $code{self} .= " and am normal weighted (ooh-arr)."; last WEIGHT; }

			if ($w eq "+++")	{ $code{self} .= " and I overflow DCU seats."; last WEIGHT; }
			if ($w eq "++")		{ $code{self} .= " and XL is snug fit."; last WEIGHT; }
			if ($w eq "+")		{ $code{self} .= " and a tad rounder than most."; last WEIGHT; }
			if ($w eq "-")		{ $code{self} .= " and everyone tells me to gain a few pounds."; last WEIGHT; }
			if ($w eq "--")		{ $code{self} .= " and I can hang-glide in an anorak and a strong breeze."; last WEIGHT; }
			if ($w eq "---")	{ $code{self} .= " and my ribs can be used as a toastrack."; last WEIGHT; }

			$code{self} .= " and my weight is unclear.";
		}
	}

	#$code{self} .= "\n";
}

sub d {
	# Dress

	$_ = shift;

	SWITCH: {

		if (!$_)		{ $code{self} .= " I'm usually dressed in jeans/combats, boots, and a t-shirt."; last SWITCH; }

		if ($_ eq "+++")	{ $code{self} .= " I consistently conform to the dress standards laid down by the Intra Office. And like it."; last SWITCH; }

		if ($_ eq "++")		{ $code{self} .= " Arrrgh! I have to wear conservative dress such as a business suit or worse, a tie."; last SWITCH; }

		if ($_ eq "+")		{ $code{self} .= " I wear a rugby shirt with the collar turned up, and either those multicolour deck shoes or the really waterproof canvas ones."; last SWITCH; }

		if ($_ eq "-")		{ $code{self} .= " I'm usually dressed in black. Anything as long as it's black, black, or for variety, white."; last SWITCH; }

		if ($_ eq "--")		{ $code{self} .= " No one can tell what I wear because I never take off my long (black) coat!"; last SWITCH; }

		if ($_ eq "---")	{ $code{self} .= " I have a pathologicalclothing attraction to the colour purple."; last SWITCH; }

		if ($_ eq "x")		{ $code{self} .= " I'm a cross dresser - Eddie Izzard is my role model: genders are for wimps"; last SWITCH; }

		if ($_ eq "?")		{ $code{self} .= " Clothes? - I have no idea what I am wearing right now, let alone what I wore yesterday."; last SWITCH; }

		if ($_ eq "pu")		{ $code{self} .= " No change - I wear the same clothes all the time, no matter the occasion, forgetting to do laundry between wearings."; last SWITCH; }

		$code{self} .= " My dress sense is absent, in more ways than one.";
	}

	#$code{self} .= "\n";
}

sub n {
	# One's notoriaty

	$_ = shift;
	$code{rb} .= " How well known am I?";

	SWITCH: {

		if ($_ eq "0")		{ $code{rb} .= " 'Ah. Um. Er. Nice weather, isn't it?' People more than know me. When I'm shaking hands and I tell them my username, their hand goes all cold and clammy."; last SWITCH; }

		if ($_ eq "1")		{ $code{rb} .= " 'Oh, so you're....' People know me, or know of me. I'm (in)famous!"; last SWITCH; }

		if ($_ eq "2")		{ $code{rb} .= " 'Oh, I think I've seen that name before...' I have the same name as some people have faces - seen it, can't quite put it in any frame of reference."; last SWITCH; }

		if ($_ eq "3")		{ $code{rb} .= " 'You are on RedBrick? Really? No you're not... Anonymity is the best defence - 'Security through Obscurity'."; last SWITCH; }

		$code{rb} .= " who knows!";

	}

	#$code{rb} .= "\n";

}

sub pn {
	# Persona

	$_ = shift;

	SWITCH: {

		if (!$_) 		{ $code{rb} .= " I have a username, but it doesn't really suggest a personality as such."; last SWITCH; }

		if ($_ eq "+++") 	{ $code{rb} .= " I look, act and talk like my user-name suggests. People go 'Hey [blah]' and I go 'Huh?' I've given up on my birth-cert and am now more properly referred to by my username."; last SWITCH; }

		if ($_ eq "++") 	{ $code{rb} .= " I'm slightly schizophrenic - I'll sometimes assume the character of my username for several hours, but eventually I'll reveal that I have a real personality too."; last SWITCH; }

		if ($_ eq "+") 		{ $code{rb} .= " I post in the character of my user-name but in real-life I'm actually quite normal."; last SWITCH; }

		if ($_ eq "-") 		{ $code{rb} .= " So I was stuck for ideas when chosing a user-name and picked on that sounded cool at the time, but is in total contrast to my personality. So sue me!"; last SWITCH; }

		if ($_ eq "--") 	{ $code{rb} .= " I use my real name (or abbreviation thereof) as a user-name. I mean, why not?"; last SWITCH; }

		if ($_ eq "---") 	{ $code{rb} .= " If numbers as usernames are good enough for Tolka, they're good enough for me!"; last SWITCH; }

		if ($_ eq "S") 		{ $code{rb} .= " My username is based on my favourite sport-star."; last SWITCH; }

		if ($_ eq "?") 		{ $code{rb} .= " I used random key-strokes for my username."; last SWITCH; }

		$code{rb} .= " My persona is a little too enigmatic.";

	}

	#$code{rb} .= "\n";
}


sub p {
	# Presence

	$_ = shift;

	SWITCH: {

		if (!$_)		{ $code{rb} .= " I might not log on for a few days at a time, but I'm not a p-...yet. Keyword: Average user."; last SWITCH; }

		if ($_ eq "+++")	{ $code{rb} .= " I don't log out. I have a modem and parents who pay the telephone bill! You are 100% likely to find me on. Keyword: Omnipresent."; last SWITCH; }

		if ($_ eq "++")		{ $code{rb} .= " I get up. I come in. I log on. I log out. I go home. I sleep. Keyword: Ubiquitous."; last SWITCH; }

		if ($_ eq "+")		{ $code{rb} .= " I log on at least once a day. Keyword: Squelchy."; last SWITCH; }

		if ($_ eq "-")		{ $code{rb} .= " I only log on once a week on average. Keyword: Pathetic."; last SWITCH; }

		if ($_ eq "--")		{ $code{rb} .= " I don't log in much. I don't see the point, but I wouldn't stop someone from doing so just so I could use Tolka. Keyword: Apathetic."; last SWITCH; }

		if ($_ eq "---")	{ $code{rb} .= " I never log in. I think p++'s take up valuable computing resources. Keyword: Antipathic."; last SWITCH; }

		$code{rb} .= " Presence? What presence?";

	}

	#$code{rb} .= "\n";
}

sub I {
	# Interface

	$_ = shift;

	SWITCH: {

		 if ($_ eq "tc"){ $code{comp} .= " I use tcsh."; last SWITCH; }
		 if ($_ eq "ba"){ $code{comp} .= " I use bash."; last SWITCH; }
		 if ($_ eq "f")	{ $code{comp} .= " I use flin."; last SWITCH; }
		 if ($_ eq "z")	{ $code{comp} .= " I use zsh."; last SWITCH; }
		 if ($_ eq "c")	{ $code{comp} .= " I use csh."; last SWITCH; }
		 if ($_ eq "s")	{ $code{comp} .= " I use sh."; last SWITCH; }
		 if ($_ eq "k")	{ $code{comp} .= " I use ksh."; last SWITCH; }
		 if ($_ eq "x")	{ $code{comp} .= " I use xsh."; last SWITCH; }
		 if ($_ eq "w")	{ $code{comp} .= " I use wsh."; last SWITCH; }
		 if ($_ eq "?")	{ $code{comp} .= " I dunno what interface I use."; last SWITCH; }

		$code{comp} .= " Can't figure out your interface.";
	}

	#$code{comp} .= "\n";
}

sub Ng {
	# Newsgroups

	$_ = shift;

	SWITCH: {

		if (!$_)		{ $code{rb} .= " I lurk on the boards. You'll never know I'm there, until it's too late!! Bwahahahahahaaa!!"; last SWITCH; }

		if ($_ eq "+++")	{ $code{rb} .= " I have opinions on everything. You name it, I know it, and I'm not afraid to show it in my posts. Abase yourselves before my superior intellect, insignificant mortals!"; last SWITCH; }

		if ($_ eq "++")		{ $code{rb} .= " I try hard, but I sometimes get my facts screwed up when I post: vis. Earth being Flat, Brittas Empire being funny, Spice Girls being nice, etc."; last SWITCH; }

		if ($_ eq "+")		{ $code{rb} .= " I post occasionally, but not too frequently."; last SWITCH; }

		if ($_ eq "-")		{ $code{rb} .= " I log in to news every so often, but it's kind of sad, isn't it?"; last SWITCH; }

		if ($_ eq "--")		{ $code{rb} .= " The newsgroups are the last refuge of sad and pathetic individuals, and I'm glad I never use them."; last SWITCH; }

		if ($_ eq "---")	{ $code{rb} .= " The newsgroups are the tool of Satan! Their users are all pawns in the global power game between the Cabbage Growers Syndicated Empire (GCSE) and the Lettuce Collective (LC) ! I will resist!"; last SWITCH; }

		if ($_ eq "s")		{ $code{rb} .= " I can kill a thread just by posting one, seemingly innocuous, remark. I hold the power!"; last SWITCH; }

		$code{rb} .= " Can't figure out your groups.";
	}

	#$code{rb} .= "\n";
}

sub WAW {
	# Warhammer

	$_ = shift;

	SWITCH: {

		if (!$_)		{ $code{misc} .= " I don't really care about Warhammer one way or the other. I'd never play it, but why stop those who do?"; last SWITCH; }

 		if ($_ eq "+++")	{ $code{misc} .= " I have a deep and psychological objection to Warhammer, a foul and depraved pastime. I have probably dated someone who played it, and as a result the words 'Chaos' and 'Eldar' are certain to make me inflict pain."; last SWITCH; }

 		if ($_ eq "++")		{ $code{misc} .= " I once asked someone what Warhammer was and it's the question I have most regretted in my life. I really do not like Warhammer. It's a bit silly really, isn't it?"; last SWITCH; }

 		if ($_ eq "+")		{ $code{misc} .= " I find the people who play Warhammer deeply amusing, and I find it difficult not to laugh at them."; last SWITCH; }

 		if ($_ eq "-")		{ $code{misc} .= " I only know a little bit about Warhammer, and I've never played it, but I can sorta see why people like it."; last SWITCH; }

 		if ($_ eq "--")		{ $code{misc} .= " I play Warhammer occasionally (or I would like to). It's fun."; last SWITCH; }

 		if ($_ eq "---")	{ $code{misc} .= " Warhammer is the best thing in my life. It's more important to me than sex, alcohol or the internet. I am a sad bastard really."; last SWITCH; }

 		if ($_ eq "?")		{ $code{misc} .= " Ermm...what's Warhammer (You lucky lucky people)."; last SWITCH; }

		$code{misc} .= " Can't figure out Warhammer (ain't that the truth).";
	}

	#$code{misc} .= "\n";
}

sub sl {
	# Slakers

	$_ = shift;

	SWITCH: {

		if (!$_)	{ $code{misc} .= " Slakers? What?"; last SWITCH; }

 		if ($_ eq "+++")	{ $code{misc} .= " I am a S.L.A.K.E.R!"; last SWITCH; }

 		if ($_ eq "++")		{ $code{misc} .= " My name is mentioned in the S.L.A.K.E.R chronicles..."; last SWITCH; }

 		if ($_ eq "+")		{ $code{misc} .= " Slakers is a bit of a laugh, I think."; last SWITCH; }

 		if ($_ eq "-")		{ $code{misc} .= " Slakers?! What a waste of disk space!"; last SWITCH; }

 		if ($_ eq "--")		{ $code{misc} .= " My name is Michael, I live in fear! (of S.L.A.K.E.R.S.)."; last SWITCH; }

 		if ($_ eq "---")	{ $code{misc} .= " I am the EVIL JAMES 'JELLYMAN' FRYAR!!!! Tremble, for one day, it will all be mine. Oh yes, one day..."; last SWITCH; }

 		if ($_ eq "\$")		{ $code{misc} .= " I hire the S.L.A.K.E.R.S to do my projects!"; last SWITCH; }

		$code{misc} .= " Can't figure out slakers - blame Thayl.";
	}

	#$code{misc} .= "\n";
}


sub E {
	# Email

	$_ = shift;

	/^(..)\[(.+)\]$/ || return;

	MUA: {

		if ($1 eq "mu")		{ $code{comp} .= " I use mutt"; last MUA; }
	 	if ($1 eq "pi")		{ $code{comp} .= " I use pine"; last MUA; }
	 	if ($1 eq "el")		{ $code{comp} .= " I use elm"; last MUA; }
	 	if ($1 eq "ot")		{ $code{comp} .= " I use some wierd ass mail reader - Netscape, Eudora, Outlook..."; last MUA; }

		$code{comp} .= " Can't figure out mua";
	}

	SPEED: {

		if ($2 eq "h")		{ $code{comp} .= " and reply to email nearly as soon as I get it. So I've nothing better to do. Your point?"; last SPEED; }

		if ($2 eq "1d")		{ $code{comp} .= " and replying to email takes > 1 day: I try my best, but hey! I've got people to do, stuff to see..."; last SPEED; }

		if ($2 eq "3d")		{ $code{comp} .= " and replying to email takes < 3 days: I try my best, but hey! I've got people to do, stuff to see..."; last SPEED; }

		if ($2 eq "3+d")	{ $code{comp} .= " and replying to email takes 3+ days: Replying to email goes to the bottom of my mental 'to do' list. If you really want a reply, ring me."; last SPEED; }

		if ($2 eq "!!")		{ $code{comp} .= " but never reply to email. I am resonsible for the provision of on-line help to computer users. In this case, Tolka. Fools email me, I don't email them. Hah!"; last SPEED; }

		$code{comp} .= " but I can't figure out email reply time.";
	}

	#$code{comp} .= "\n";
}

sub w {
	# Web

	$_ = shift;

	SWITCH: {

		if (!$_)		{ $code{comp} .= " I think it'd be handy to have a browser and a web connection, but DCU took it away. Occasionally I'll try use the dregs they've left us."; last SWITCH; }

		if ($_ eq "+++")	{ $code{comp} .= " I am a Webmaster. Don't even think about trying to view my homepage without the latest version of Netscape. When I'm not on my normal net connection (which I can't use 'cos DCU are cheap bastards), I surf the web using my Newton and a cellular modem. I am on one of the 16 Web-capable computers almost always when I'm in."; last SWITCH; }

		if ($_ eq "++")		{ $code{comp} .= " I have a homepage. I used to surf daily - now I queue. My homepage is advertised in my .signature."; last SWITCH; }

		if ($_ eq "+")		{ $code{comp} .= " I have the latest version of Netscape, and wander the web only when there's something specific I'm looking for (and I can manage to get a web PC)."; last SWITCH; }

		if ($_ eq "-")		{ $code{comp} .= " The web is really a pain. Life was so much easier when you could transfer information by simple ASCII. Now everyone won't even consider your ideas unless you spiff them up with bandwidth-consuming pictures and pointless information links."; last SWITCH; }

		if ($_ eq "--")		{ $code{comp} .= " A pox on the web! It wastes time and bandwidth and just gives the uneducated morons a reason to clutter the Internet. I delight in using Word on the few Web PCs in the place."; last SWITCH; }

		if ($_ eq "---")	{ $code{comp} .= " I am the man responsible for determining DCU's web access policy. Fear me. I can slap a £10,000 fine on you for any reason! Hahahahaha!!!!"; last SWITCH; }

		$code{comp} .= " My webness is in doubt.";
	}

	#$code{comp} .= "\n";
}

sub DCU {
	# DCU sentiment

	$_ = shift;

	SWITCH: {

		if ($_ eq "*")	{ $code{dcu} .= " I love DCU!"; last SWITCH; }
		if ($_ eq "#")	{ $code{dcu} .= " I hate DCU!"; last SWITCH; }

		$code{dcu} .= " I <something> DCU!";
	}

	#$code{dcu} .= "\n";
}

sub A {
	# DCU authority

	my $u;
	($_,$u) = split(/u/, shift);

	SWITCH: {

		if (!$_)	{ $code{dcu} .= " Wagagagagaga."; last SWITCH; }
		if ($_ eq "y")	{ $code{dcu} .= " I reckon the DCU authority is worth a damn."; last SWITCH; }
		if ($_ eq "n")	{ $code{dcu} .= " I reckon the DCU authority isn't worth a damn."; last SWITCH; }
		if ($_ eq "?")	{ $code{dcu} .= " How would I know if the DCU authority is worth a damn?"; last SWITCH; }

		$code{dcu} .= " Umm, something about an authority.";
	}

	# student union

	$_ = $u;

	SWITCH: {

		if (!$_)	{ $code{dcu} .= " Wugugugugugu."; last SWITCH; }
		if ($_ eq "y")	{ $code{dcu} .= " I reckon the student union is worth a damn."; last SWITCH; }
		if ($_ eq "n")	{ $code{dcu} .= " I reckon the student union isn't worth a damn."; last SWITCH; }
		if ($_ eq "?")	{ $code{dcu} .= " How would I know if the student union is worth a damn?"; last SWITCH; }

		$code{dcu} .= " Umm, something about a union.";
	}

	#$code{dcu} .= "\n";
}

sub L {
	# Lectures

	$_ = shift;

	SWITCH: {

		if (!$_)		{ $code{dcu} .= " I go to most of my lectures. Except that damned 9 o'clocker on Friday morning. Have been known to fall asleep at the back of the room."; last SWITCH; }

 		if ($_ eq "+++")	{ $code{dcu} .= " I go to all my lectures. I am on first name terms with my lecturers. I quite like them and have had dinner with their families. They are my close personal friends. I value their opinion of me. We shag."; last SWITCH; }

 		if ($_ eq "++")		{ $code{dcu} .= " I go to all my lectures. Early. Ask questions at the end. I enjoy them."; last SWITCH; }

 		if ($_ eq "+")		{ $code{dcu} .= " I go to all of my lectures."; last SWITCH; }

 		if ($_ eq "-")		{ $code{dcu} .= " I'm a 50-50 kinda person. Don't like to leave Chat to go to a lecture, especially if it's raining and I have to walk ALL that distance. Regularly fall asleep anywhere. I don't care if I snore."; last SWITCH; }

 		if ($_ eq "--")		{ $code{dcu} .= " I go to all my lectures, except Monday to Thursday, and 9.00 until 6.00 on Fridays."; last SWITCH; }

 		if ($_ eq "---")	{ $code{dcu} .= " Lectures? We have lectures? Oh, so that's where everyone goes? I photocopy notes the night before exams."; last SWITCH; }

 		if ($_ eq "r+")		{ $code{dcu} .= " I'm repeating outside the college but sneak into lectures anyway."; last SWITCH; }

 		if ($_ eq "r-")		{ $code{dcu} .= " I'm repeating outside the college but hang around the canteen and don't go to lectures for old times sake."; last SWITCH; }

 		if ($_ eq "!")		{ $code{dcu} .= " I give the f*&%?^@ lectures!"; last SWITCH; }

		$code{dcu} .= " I need to attend more lectures.";
	}

	#$code{dcu} .= "\n";
}

sub F {
	# Drinks/Frodos/CSS

	$_ = shift;
	$code{dcu} .= " Campus 'Social Centre'?";

	SWITCH: {

		if (!$_)		{ $code{dcu} .= " Right, I'm having *one pint* then we're going to Quinns, alright!?"; last SWITCH; }

 		if ($_ eq "+++")	{ $code{dcu} .= " 'Hi, I'm really stuck for money, can I take your order?'"; last SWITCH; }

 		if ($_ eq "++")		{ $code{dcu} .= " Hmm, it's an alright place, but then again, yellow *is* my favourite colour."; last SWITCH; }

 		if ($_ eq "+")		{ $code{dcu} .= " Don't really like the place, but I drink there because loads of my friends are there too."; last SWITCH; }

 		if ($_ eq "-")		{ $code{dcu} .= " I only drink there if I have a free pint voucher...And even then only because the voucher doesn't work anywhere else!"; last SWITCH; }

 		if ($_ eq "--")		{ $code{dcu} .= " I went in there to use the toilets once, it wasn't pretty..."; last SWITCH; }

 		if ($_ eq "---")	{ $code{dcu} .= " The decor is shite, the drink is watered, the prices are too high, the staff are rude, the music is woeful, and my name is Sandman."; last SWITCH; }

		$code{dcu} .= " I dunno 'bout Frodo's.";
	}

	#$code{dcu} .= "\n";
}

sub So {
	# Socials

	$_ = shift;

	SWITCH: {

		if (!$_)		{ $code{rb} .= " I've been on a few RedBrick nights out, but I wouldn't go out of my way to get a ticket, and sure I've nowhere to stay anyway."; last SWITCH; }

 		if ($_ eq "+++")	{ $code{rb} .= " I organise the RedBrick nights out, sell tickets, and blow up balloons"; last SWITCH; }

 		if ($_ eq "++")		{ $code{rb} .= " Haven't missed an event yet. RedBrick is the best thing that ever happened to my social life."; last SWITCH; }

 		if ($_ eq "+")		{ $code{rb} .= " I enjoy RedBrick nights out, like the crowd, and make an effort to put in an appearance at most of the outings."; last SWITCH; }

 		if ($_ eq "-")		{ $code{rb} .= " I don't like RedBrick nights out, because there's nobody else logged on when I stay in the Labs."; last SWITCH; }

 		if ($_ eq "--")		{ $code{rb} .= " I don't go out much anyway, but if I did, you can bet it wouldn't be with a bunch of computer nerds."; last SWITCH; }

 		if ($_ eq "---")	{ $code{rb} .= " What, go out with RedBrick, when I could be in Jets? Pah."; last SWITCH; }

 		if ($_ eq "#")		{ $code{rb} .= " I am Sandman, and I used to be in charge of RedBrick's social aspect, but now somebody else has to do it. Muahahahahaha."; last SWITCH; }

		$code{rb} .= " I can't articulate my social-ness.";
	}

	# $code{rb} .= "\n";
}

#sub p {
#	# Presence
#
#	$_ = shift;
#
#	SWITCH: {
#
#		if (!$_)	{ print ""; last SWITCH; }
# 		if ($_ eq "+")	{ print ""; last SWITCH; }
#
#		print "Can't figure out whatever";
#	}
#
#	print "\n";
#}

sub wrap {
# From http://soupermail.sourceforge.net/soupermail.pl.txt

	my ($wrap, $buffer) = @_;
	my ($start, $rest, $tmp, $something);
	### Need to isolate words longer than the wrap size ...
	$$buffer =~ s/([^\s]{$wrap,})\s/\n$1\n/g;
	### ... and then do real wrapping.
	while ($$buffer =~ /([^\n]{$wrap})/) {
		$start = $`;
		$rest = $';
		$something = $1;
		$something =~ s/((.|\n)*)\s((.|\n)*)/$1\n$3/;
		$something =~ /((.|\n)*)(\n.*)/;
		$tmp .= $start . $1;
		$$buffer = $3 . $rest;
	}
	$$buffer = $tmp . $$buffer;
}