#!/usr/bin/env perl

use strict;

exit main( @ARGV );

#---------------------------------------------------------------------
sub main {
    my $stuff = {};
    @ARGV = ();
    print STDERR (join "\n", @ARGV, '');
    EmitHeader( $stuff );
    EmitBody( $stuff );
    EmitFooter( $stuff );
    return 0;
}

#---------------------------------------------------------------------
sub EmitHeader {
    my ( $stuff ) = @_;
}

#---------------------------------------------------------------------
sub EmitBody {
    my ( $stuff ) = @_;

    while (my $line = <>) {
	chomp $line;
	if ( $line =~ m/\A@[f]ile(\s(.*)|)\z/ ) {
	    my $filename = $2;
	    HandleFile( $stuff, $filename );
	}
	elsif ( $line =~ m/\A@[b]egin docs (\d+)\z/ ) {
	    my $chunk_number = $1;
	    HandleDocs( $stuff, $chunk_number );
	}
	elsif ( $line =~ m/\A@[b]egin code (\d+)\z/ ) {
	    my $chunk_number = $1;
	    HandleCode( $stuff, $chunk_number );
	}
    }
}

#---------------------------------------------------------------------
sub EmitFooter {
    my ( $stuff ) = @_;
}

#---------------------------------------------------------------------
sub HandleFile {
    my ( $stuff, $filename ) = @_;
    if ( $filename ) {
	print STDOUT "<h1>$filename</h1>\n";
	$stuff->{'filename'} = $filename;
    }
}


#---------------------------------------------------------------------
sub ReadLinesUntil {
    my ( $end ) = @_;
    my @lines = ();

    while ( my $line = <> ) {
	chomp $line;
	last if ( $line eq $end );
	push @lines, $line;
    }

    return \@lines;
}

#---------------------------------------------------------------------
sub MakeChunkNameComment {
    my ( $name, $seq, $lang ) = @_;
    my %commenters = (
	'lisp' => sub { my ( $nn ) = @_; return ";;; $nn"; },
	'c' => sub { my ( $nn ) = @_; return "/* $nn */"; },
	'c++' => sub { my ( $nn ) = @_; return "// $nn"; },
	'default' => sub { my ( $nn ) = @_; return "# $nn"; },
    );

    if ( $seq > 0 ) {
	return MakeChunkNameComment( "$name (cont.)", 0, $lang );
    }
    else {
	my $commenter = $commenters{$lang};
	if ( ! $commenter ) {
	    return MakeChunkNameComment( $name, 0, 'default' );
	}
	elsif ( ref( $commenter ) eq 'CODE' ) {
	    return &$commenter($name);
	}
	else {
	    return MakeChunkNameComment( $name, 0, $commenter );
	}
    }
}

#---------------------------------------------------------------------
sub GetChunkReference {
    my ( $name, $lang ) = @_;
    my %referencers = (
	'lisp' => sub { my ( $nn ) = @_; return "#<:use \"$nn\">" },
	'c' => 'default',
	'c++' => 'c',
	'default' => sub { my ( $nn ) = @_; return "<<$nn>>" },
    );

    my $referencer = $referencers{$lang};
    if ( ! $referencer ) {
	return GetChunkReference( $name, 'default' );
    }
    elsif ( ref( $referencer ) eq 'CODE' ) {
	return &$referencer($name);
    }
    else {
	return GetChunkReference( $name, $referencer );
    }
}

#---------------------------------------------------------------------
sub HandleDocs {
    my ( $stuff, $chunk_number ) = @_;
    my $lines = ReadLinesUntil( '@end docs ' . $chunk_number );
    my $last_was_nl = 0;

    foreach my $line ( @$lines ) {
	if ( $line =~ m/\A@[t]ext (.*)\z/ ) {
	    my $text = $1;
	    print STDOUT $text;
	    $last_was_nl = 0 if $text;
	}
	elsif ( $line =~ m/\A@[n]l\z/ ) {
	    if ( $last_was_nl == 1 ) {
		print STDOUT "\n\n";
	    }
	    else {
		print STDOUT " ";
	    }
	    ++$last_was_nl;
	}
	elsif ( $line =~ m/\A@[q]uote\z/ ) {
	    print STDOUT "[cci]";
	    $last_was_nl = 0;
	}
	elsif ( $line =~ m/\A@[e]ndquote\z/ ) {
	    print STDOUT "[/cci]";
	    $last_was_nl = 0;
	}
	elsif ( $line =~ m/\A@[u]se (.*)\z/ ) {
	    my $name = $1;
	    my $reference = GetChunkReference( $name, 'default' );
	    print STDOUT $reference;
	    $last_was_nl = 0;
	}
    }
}

#---------------------------------------------------------------------
sub MakeAnchor {
    my ( $name, $seq ) = @_;
    my $ret = ( $seq > 0 ) ? "$name $seq" : "$name";
    $ret =~ s/\s+/-/g;
    return $ret;
}

#---------------------------------------------------------------------
sub HandleCode {
    my ( $stuff, $chunk_number ) = @_;
    my $lines = ReadLinesUntil( '@end code ' . $chunk_number );
    my $lang = '';
    my $name = '';

    foreach my $line ( @$lines ) {
	if ( $line =~ m/\A@[l]anguage (.*)\z/ ) {
	    $lang = $1;
	}
	elsif ( $line =~ m/\A@[d]efn (.*)\z/ ) {
	    $name = $1;
	}
    }

    my $seq = scalar @{ $stuff->{'chunks_for'}{$name} || [] };
    my $anchor = MakeAnchor( $name, $seq );
    push @{ $stuff->{'chunks_for'}{$name} }, $anchor;

    print STDOUT "<a name=\"$anchor\">";
    print STDOUT "[cc";
    print STDOUT " lang=\"$lang\"" if $lang;
    print STDOUT "]\n";

    print STDOUT MakeChunkNameComment( $name, $seq, $lang );

    foreach my $line ( @$lines ) {
	if ( $line =~ m/\A@[t]ext (.*)\z/ ) {
	    my $text = $1;
	    print STDOUT $text;
	}
	elsif ( $line =~ m/\A@[n]l\z/ ) {
	    print STDOUT "\n";
	}
	elsif ( $line =~ m/\A@[u]se (.*)\z/ ) {
	    my $name = $1;
	    my $reference = GetChunkReference( $name, $lang );
	    print STDOUT $reference;
	}
    }

    print STDOUT "[/cc]</a>\n";
}