#!/usr/bin/perl --

use strict;

## read a log of a role-playing session generated by the tinyFugue (tf)
## MUSH/MUD client, clean it, and and highlight it using standard bulletin
## board markup.
##
##  --Poison Ivy @ Gotham Knights
## 2005/02/15  basics
## 2005/02/17  support *markup*
## 2005/02/18  support -markup-
## 2005/03/26  allow / (for italics) within quoted text
## 2005/04/02  don't detect / (for italics) in [/x] from previous substitution
## 2005/04/04  multi-detect / (for italics) in ""
## 2005/06/12  recognize <Phone>, have colour configurables in preamble
## 2005/07/02  fix a bug with -emphasis-

## read in paragraph mode -- this is necessary if the client word-wraps the
## logs; if it doesn't and one pose is one line in the log (regardless of
## length), put a # in front of the following line to disable it:
$/='';


my %cols = ( 'OOC'     => 'darkred',
             'desc'    => 'darkred',
             'page'    => 'green',
             'channel' => 'olive',
             'dialog'  => 'darkblue' );

## no user-configurables after this point.



## ----------------------------------------------------------------------------

## no previous paragraph yet, set to empty string
my $p="";

## line counter
my $c=0;

while(<>) {
  ## removing trailing newlines
  chomp;
  chomp;

  ## remove line-breaks in the middle of poses/paragraphs
  s/\n/ /sg;

  ## remove extra spaces
  s/\s{2,}/ /g;
  s/^(.*?)[\t ]+$/$1/g;



  ## if this paragraph is a duplicate of the previous one, discard it
  if ( $p eq $_ ) {
    next; }



  ## technical feedback from the game server
  if ( $_ =~ m/^GAME: .*$/ ) {
    next; }

  if ( $_ =~ m/^Huh\?  \(Type "help" for help\.\)/ ) {
    next; }



  ## output multi-descer ("You changed your description")
  if ( $_ =~ m/^Excellent choice!/ ) {
    next; }



  ## remember this paragraph so we can catch duplicates
  $p=$_;



  ## make log title (first non-empty line in log) bold
  if($c==0) {
    s-(.*)-[b]${1}[/b]-; }



  ## HANDLE MARKUP

  ## _underline_ -> [u]underline[/u]
  s-_([^_]+?)_-[u]${1}[/u]-g;

  ## "/italics/" -> "[u]italics[/u]"  (in quoted text)
  while(m-"(|((.*)[^\[]))/([^/"]*)([^\[])/(.*)"-) {
    s-"(|((.*)[^\[]))/([^/"]*)([^\[])/(.*)"-"${1}[u]${4}${5}[/u]${6}"-g; }

  ## /italics/ -> [i]italics[/i]      (in narration)
  s-([^\[])/([^/]+?)([^\[])/-${1}[i]${2}${3}[/i]-g;
  s-^/([^/]+?)([^\[])/-${1}[i]${2}${3}[/i]-g;

  ## -strikethru- -> [u]strikethru[/u]
  s&\s-+(\w+?)-\s+& [u]${1}[/u] &g;

  ## *bold* -> [b]bold[/b]
  s-\*+([^*]+?)\*+-[b]${1}[/b]-g;



  ## HANDLE ENTITIES

  ## -- -> &mdash;
# s/-{2,}/&mdash;/g;



  ## HIGHLIGHT BY COMMUNICATION TYPE

  ## paging (long distance communication)
  if ( $_ =~ m/^.* pages[^:]*: .*/ ) {
    print "[color=".$cols{'page'}."]".$_."[/color]\n\n"; }
  elsif ( $_ =~ m/^You paged .* with .*/ ) {
    print "[color=".$cols{'page'}."]".$_."[/color]\n\n"; }
  elsif ( $_ =~ m/^Long distance to [^:]*: .*/ ) {
    print "[color=".$cols{'page'}."]".$_."[/color]\n\n"; }
  elsif ( $_ =~ m/^From afar.*, .*/ ) {
    print "[color=".$cols{'page'}."]".$_."[/color]\n\n"; }



  ## Out Of Character (stage direction)
  elsif ( $_ =~ m/^\<OOC\>\s.*/ ) {
    print "[color=".$cols{'OOC'}."]".$_."[/color]\n\n"; }



  ## room and other descriptions
  elsif ( $_ =~ m/^\{(.*)\}$/ ) {
    print "[color=".$cols{'desc'}."]".$1."[/color]\n\n"; }



  ## channels (MUSH-wide public conversation)
  elsif (!( $_ =~ m/^\<Phone\> .*/ ) && ( $_ =~ m/^\<\w+\> .*/ )) {
#   print "[color=".$cols{'channel'}."]".$_."[/color]\n\n";
  }



  ## the actual play
  else {
    s-"([^"]+)"-[i][color=$cols{'dialog'}]"$1"[/color][/i]-g;
    print $_."\n\n"; }

  $c++; }