#! /usr/bin/perl

use POSIX qw(strftime);

@CheckNames =();
undef @NameOrder; undef %Level; undef %Names;

push @PostGeneration, \&x_check_names;
sub x_check_names {
    # Let's do a bit checking
    foreach (@CheckNames) {
        print STDERR "Warning: name $_ does not exist in document\n" unless exists $Names{$_};
    }
}


$Funcs{"name"} = \&makeName;
sub makeName {
    my ($name, $desc, $subst) = ($_[0] =~ /^[ ]*([^ ]+)[ ]?(.*)/);

    if ($name =~ s/^(\053+)//) {
        $Level{$name} = length ($1) ;
    } else {
        $Level{$name} = 0;
    }
    
    $desc = $name unless length $desc;

    $desc =~ s/^\s*//;
    $desc =~ s/\s*$//;

    $Names{$name} = $desc;
    push @NameOrder, $name; 
    
    return "<a name=\"$name\">$desc</a>";
}

$Funcs{"h3-"} = \&html_h3_index;
sub html_h3_index {
    my $h3_x;
    my $section_name;
    
    $h3_x = $Vars{"h3 index"} if exists $Vars{"h3 index"};
    if (!defined $h3_x) {$Vars{"h3 index"} = $h3_x = "0"; }
    
    ++ $h3_x; $Vars{"h3 index"} = $h3_x;
    
    $section_name = "$h3_x";
    
    return "<h3>" . makeName ("$section_name ". $_[0]) . "</h3>";
}

$Funcs{"h4-"} = \&html_h4_index;
sub html_h4_index {
    my ($h3_x, $h4_x);
    my $section_name;
    
    $h3_x = $Vars{"h3 index"} if exists $Vars{"h3 index"};
    $h4_x = $Vars{"h4 index"} if exists $Vars{"h4 index"};
    
    if (!defined $h4_x) {$Vars{"h4 index"} = $h4_x = "0"; }
    
    ++ $h4_x; $Vars{"h4 index"} = $h4_x;
    
    if (defined $h3) {
       $section_name = "$h3_x.$h4_x";
    }else{
       $section_name = "$h4_x";
    }
    
    return "<h4>" . makeName ("$section_name ". $_[0]) . "</h4>";
}

$Funcs{"h3+"} = \&html_h3_index_;
sub html_h3_index_ {
    my $h3_x;
    my $section_name;
    
    $h3_x = $Vars{"h3 index"} if exists $Vars{"h3 index"};
    if (!defined $h3_x) {$Vars{"h3 index"} = $h3_x = "0"; }
    
    ++ $h3_x; $Vars{"h3 index"} = $h3_x;
    
    $section_name = "$h3_x";
    
    return "<h3>" . makeName ("$section_name $section_name ". $_[0]) . "</h3>";
}

$Funcs{"h4+"} = \&html_h4_index_;
sub html_h4_index_ {
    my ($h3_x, $h4_x);
    my $section_name;
    
    $h3_x = $Vars{"h3 index"} if exists $Vars{"h3 index"};
    $h4_x = $Vars{"h4 index"} if exists $Vars{"h4 index"};
    
    if (!defined $h4_x) {$Vars{"h4 index"} = $h4_x = "0"; }
    
    ++ $h4_x; $Vars{"h4 index"} = $h4_x;
    
    if (defined $h3) {
       $section_name = "$h3_x.$h4_x";
    }else{
       $section_name = "$h4_x";
    }
    
    return "<h4>" . makeName ("$section_name $section_name ". $_[0]) . "</h4>";
}

%ColorScheme = (
       "white" => "bgcolor=#ffffff fgcolor=#000000",
       "black" => "bgcolor=#000000 fgcolor=#ffffff",
       "sand"  => "bgcolor=#FFFFE0 fgcolor=#000000 link=#200080 vlink=#200040 alink=#8080FF",

       # foreground/background
       "black/white" => "bgcolor=#ffffff fgcolor=#000000",
       "white/black" => "bgcolor=#000000 fgcolor=#ffffff",
);

$Funcs{"Color"} = \&setColorScheme;
$Funcs{"color"} = \&setColorScheme;
sub setColorScheme 
{
    my ($x) = @_;
    if (exists $ColorScheme{$x}) {
        for $entry (split(' ', $ColorScheme{$x})) {
           $entry =~ m/([^=]+)=(.*)/;
           $Vars{$1} = $2;
        }           
    }
    elsif ($x eq "white") {
        $Vars{"bgcolor"}="#ffffff";
        $Vars{"fgcolor"}="#000000";
    } else {
        die "Unknown color scheme";
    }
    
    return "";
}

# Table of contents, based on names
$Funcs{"content_table"} = \&makeContents;
$Funcs{"content-table"} = \&makeContents;
$Funcs{"content-table-#"} = \&makeContents;
sub makeContents 
{
    my $all = $_[0];
    my ($x, $level);

    $x = "{ul:\n";

    $level = 0;

    foreach (@NameOrder) {
        # print  "Level{$_} = $Level{$_}\n";
    }

    foreach (keys %Level) {
        # print STDERR "Level{$_} = $Level{$_}\n";
    }
    
    # foreach (sort { $Position{$a} <=> $Position{$b} } keys %Names) {
    foreach (@NameOrder) {
        #        print STDERR "Level: $Level{$_} from $level\n";
        if ($Level{$_} > $level) {
            $x .= ("  " x ($Level{$_})) . "{ul:\n" x ($Level{$_} - $level);
        } elsif ($level > $Level{$_}) {
            $x .= ("  " x $level) . "}\n" x ($level - $Level{$_});
        }
        $level = $Level{$_};
        $x .= "  " x (1+$level) . "{li: {href:(nounder) #$_ $Names{$_}}}\n";
    }

    $x .= "  " x $level . "}\n" while $level-- >= 0;
    
    #    print STDERR "$x\n";

    return "<!-- START content-table -->\n" . $x 
         . "<!-- END content-table -->\n" . $all;
}

$Funcs{"autotable"} = \&makeAutoTable;
sub makeAutoTable 
{
    my (@Cells,$width,$s,$col,$x);
    if (exists $Args{delimiter}) {
        $Args{delimiter} =~ s/\\(\d{3})/chr(oct($1))/ge;
        @Cells = split($Args{delimiter},$_[0]);
        delete $Args{delimiter};
    } else {
        @Cells = split(",",$_[0]);
    }
    
    $width = $Args{width}; delete $Args{width};
    die "width not defined in autotable?" unless defined($width);
    
    $col = 0;
    $x = "<TABLE" . &getArgs() . ">\n";
    
    foreach $s (@Cells) {
        if ($col == 0) {
            $x .= "<TR>";
        }
        $x .= "<TD>$s</TD>\n";
        if (++$col == $width) {
            $x .= "</TR>";
            $col = 0;
        }
    }
    if ($col == 0) {
        $x .= "</TR>\n";
    }

    $x .="</TABLE>";

    return $x;
    
}

# -------------------------------------------------------------------
# commentors: tags may contain #, it is a good way to mark comment
#             generating / scripting thingies with #

$Funcs{"-#"} = \&html_blind_comment;
sub html_blind_comment
{
   return "";
}

$Funcs{"-#-"} = \&html_comment_END;
sub html_comment_END
{
   return "<!-- END ".$_[0]."-->";
}

$Funcs{"+#+"} = \&html_comment_START;
sub html_comment_START
{
   return "<!-- START ".$_[0]."-->";
}

$Funcs{"*--"} = \&html_comment;
sub html_comment
{
   return "<!-- ".$_[0]."-->";
}


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

$Funcs{"Subject"} = \&html_title;
$Funcs{"title"}   = \&html_title;
sub html_title 
{
    ($Title) = @_;
    $Vars{"Subject"} = $Title ;
    return "{h1: $Title}" if $parse_body;
    return "";
}

# When was this page last changed, handily formatted, dd.mmm'yy
$Funcs{"file-ctime"} = \&file_ctime;
$Funcs{"last-change"} = \&file_ctime;
sub file_ctime {
    my ($mtime,$s) = (stat($currentFile))[9];
    $s = &ctime($mtime); 
    return strftime "%d.%b'%y", gmtime($mtime);
}

# When was this page last changed, handily formatted, mmm'yy
$Funcs{"file-date"} = \&html_file_date;
sub html_file_date {
    my ($mtime,$s) = (stat($currentFile))[9];
    $s = &ctime($mtime); 
    return strftime "%b'%y", gmtime($mtime);
}

# When was this page last changed, handily formatted
$Funcs{"put"} = \&html_put_var;
sub html_put_var {
    my ($var, $def) = ($_[0] =~ /^\s+(\S+)\s+(.*)$/);
    if (!defined $var) { $var = $_[0]; $def = ""; }
    if (exists $Vars{$var}) 
       	{ return $Vars{$var}; }
    return $def;
}

#fields are seperated by a vertical bar
$Funcs{"box-le-re"} = \&html_box_left_right;
$Funcs{"box-2"} = \&html_box_left_right;
sub html_box_left_right
{
    my $cellwidth = "";
    my ($leftText, $rightText) = ($_[0] =~ /^(.*)\|(.*)$/s);
    if (!defined $rightText) {
       $leftText = $_[0];
       $rightText = "&nbsp;";
    }

    $Args{"width"} = "100%"      unless exists $Args{"width"};
    $Args{"border"} = "0"        unless exists $Args{"border"};
    $Args{"cellspacing"} = "0"   unless exists $Args{"cellspacing"};
    $Args{"cellpadding"} = "0"   unless exists $Args{"cellpadding"};
    
    $cellwidth = " width=".(delete $Args{"cellwidth"})
                	if (exists $Args{"cellwidth"});

    return "<table" . &getArgs()
         . ">\n<tr><td align=left$cellwidth>\n"    . $leftText 
         . "\n</td><td align=right$cellwidth>\n"   . $rightText 
         . "\n</td></tr></table>";
}

#fields are seperated by vertical bars
$Funcs{"box-le-ce-re"} = \&html_box_left_center_right;
$Funcs{"box-3"} = \&html_box_left_center_right;
sub html_box_left_center_right
{
    my $cellwidth = "";
    my ($leftText, $centerText, $rightText) = ($_[0] =~ m/^(.*)\|(.*)\|(.*)$/s );
    if (!defined $rightText) {
       ($leftText, $centerText) = ($_[0] =~ m/^(.*)\|(.*)$/s );
       $rightText = "&nbsp;";
    }
    if (!defined $leftText) {
       $leftText = "&nbsp;";
       $centerText = $_[0];
       $rightText = "&nbsp;";
    }

    $Args{"width"} = "100%"      unless exists $Args{"width"};
    $Args{"border"} = "0"        unless exists $Args{"border"};
    $Args{"cellspacing"} = "0"   unless exists $Args{"cellspacing"};
    $Args{"cellpadding"} = "0"   unless exists $Args{"cellpadding"};
    
    $cellwidth = " width=".(delete $Args{"cellwidth"})
                	if (exists $Args{"cellwidth"});

    return "<table" . &getArgs()
         . ">\n<tr><td align=left$cellwidth>\n"    . $leftText 
         . "\n</td><td align=center$cellwidth>\n"  . $centerText 
         . "\n</td><td align=right$cellwidth>\n"   . $rightText 
         . "\n</td></tr></table>";
}

$Funcs {"box-30"} = \&html_box_3_equal;
sub html_box_3_equal
{
    $Args{"cellwidth"} = "30%" unless exists $Args{"cellwidth"};
    html_box_left_center_right (@_);
}

$Funcs {"box-50"} = \&html_box_2_equal;
sub html_box_2_equal
{
    $Args{"cellwidth"} = "50%" unless exists $Args{"cellwidth"};
    html_box_left_right (@_);
}

# a nice visual: a vertcal tabb, the upper-portion is just color filled,
# while the lower-portion contains some text in a box
$Funcs{"vtabb"} = \&html_vtabb;
sub html_vtabb
{
    my ($text) = $_[0];
    
    if (!exists $Args{"border"}) { $Args{"border"} = "0"; }
    if (!exists $Args{"cellspacing"}) { $Args{"cellspacing"} = "0"; }
    if (!exists $Args{"cellpadding"}) { $Args{"cellpadding"} = "0"; }
    
    if (!exists $Args{"bordercolor"}) { $Args{"bordercolor"} = $Vars{"fgcolor2"}; }

    my $rep = "<table border=0 bgcolor=" . $Args{bordercolor} ;
    if (exists $Args{"width"}) { 
       $rep .= " width=" . $Args{"width"};
       delete $Args{"width"};
    }
    
    $rep .= "><tr><td>" ;
    $rep .= "<table border=0 width=100% bgcolor=" . $Vars{"bgcolor"};
    $rep .= "><tr><td bgcolor=" . $Args{"bordercolor"} ;
    $rep .= "> &nbsp; </tr></td><tr><td" . &getArgs . " >";
    $rep .= $text ;
    $rep .= "</td></tr></table></td></tr></table>";
}

# a nice visual: a horizontal tabb, the left-portion is just color filled
# while the right-portion contains some text in a box
$Funcs{"htabb"} = \&html_htabb;
sub html_htabb
{
    my ($text) = $_[0];
    
    if (!exists $Args{"border"}) { $Args{"border"} = "0"; }
    if (!exists $Args{"cellspacing"}) { $Args{"cellspacing"} = "0"; }
    if (!exists $Args{"cellpadding"}) { $Args{"cellpadding"} = "0"; }
    
    if (!exists $Args{"bordercolor"}) { $Args{"bordercolor"} = $Vars{"fgcolor2"}; }

    my $rep = "<table border=0 bgcolor=" . $Args{bordercolor} ;
    if (exists $Args{"width"}) { 
       $rep .= " width=" . $Args{"width"};
       $Args{"width"} = "100%";
    }
    
    $rep .= "><tr><td>" ;
    $rep .= "<table border=0 bgcolor=" . $Vars{"bgcolor"};
    $rep .= "><tr><td bgcolor=" . $Args{"bordercolor"} ;
    $rep .= "> &nbsp; </td><td" . &getArgs . ">";
    $rep .= $text ;
    $rep .= "</td></tr></table></td></tr></table>";
}

# some function from the elder smart-html-package system
# just does things a little different than html_href
$Funcs{"url"} = \&html_url;
sub make_url {
    my ($url, $desc) = ($_[0] =~ /^([^,]+),?(.*)/);
    $desc = $url unless length $desc;

    $desc =~ s/^\s*//;
    $desc =~ s/\s*$//;
    $desc =~ s/^#//;
    
    if ($url =~ m#//# or $url =~ m#^/#) { # Already URI?
    } elsif ($url =~ /@/) {
        $url = "mailto:$url";
    } elsif ($url =~ m#\.[a-zA-Z]{2,3}/# or $url =~ m#/$# or $url =~ /^www/) {
        if (($url =~ /^www/) or ($url !~ /\.(gz|zip|bz2|v\d)$/)) {
            $url = "http://$url";
        }
    }

    # Remember to check those URls later
    if ($url =~ /^#(.*)/) {
        push @CheckNames, $1;
    }
    
    return "<a href="http://freespace.sourceforge.net/guidod/htm1-pp.1.1/build/etc/\&quot;$url\&quot;">$desc</a>";
}

# make a href-link, the first part is the link-path
# the latter is the definition inside of the href
$Funcs{"href"} = \&html_href;
sub html_href {
    my ($url, $desc) = ($_[0] =~ /([^ ]+) ?(.*)/);
    $desc = $url unless length $desc;
    
    $desc =~ s/^\s*//;
    $desc =~ s/\s*$//;
    $desc =~ s/^#//;
    
    if ($url =~ m#//# or $url =~ m#^/#) { # Already URI?
    } elsif ($url =~ /@/) {
        $url = "mailto:$url";
    } elsif ($url =~ m#\.[a-zA-Z]{2,3}/# or 
             $url =~ m#/$# or $url =~ /^www/) {
        if (($url =~ /^www/) or ($url !~ /\.(gz|zip|bz2|v\d)$/)) {
            $url = "http://$url";
        }
    }

    # Remember to check those URls later
    if ($url =~ /^#(.*)/) {
        push @CheckNames, $1;
    }
    
    return "<a href="http://freespace.sourceforge.net/guidod/htm1-pp.1.1/build/etc/\&quot;$url\&quot;&quot;" . &getArgs() . ">$desc</a>";
}

$Funcs{"e-mail"} = \&html_e_mail;
sub html_e_mail {
    my ($url, $desc) = ($_[0] =~ /([^ ]+) ?(.*)/);
    $desc = "" unless length $desc;
    
    $_ = $url;
    /\?/ && s:^([^\?]*)\?.*:$1:s; # chop off anything past ?
    /\@/ && s:\@:<small>\@</small>:s; # make the 'at' smaller
    return "<i><small>e-mail:</small></i><a href="http://freespace.sourceforge.net/guidod/htm1-pp.1.1/build/etc/\&quot;mailto:$url\&quot;"><i>$_</i> $desc</a>";
}

# create an img-tag - the first portion is the image-filename
# the rest held to be the alt-tag, if nothing besides the filename
# could be found, try to figure out a good alt-tag from the filename
$Funcs{"img"} = \&html_img;
sub html_img {
    my ($url,$alt) = ($_[0] =~ m/[ ]*([^\ ]*)[ ]?(.*)/ );
    if (!exists $Args{"alt"}) {
       getalt: {
           if (defined($alt)) { last getalt; }
           # now try to guess a good $alt-tag from the $url
           $alt = $url;
           $alt =~ s{^([^\?]*)[\?]?(.*)$}{$1}s ; # strip dynamic parts (if any)
           $alt =~ s{^(.*)\.\w+$}{$1}sg ;        # strip file extensions 
           $alt =~ s{file:(.*)}{$1}s;

           # maybe there's a file with the alt-text in there ...
           if ($alt !~ m/^\w+:/ and -f "$alt.alt") {
              $altalt = `cat $alt.alt`;
              if (2 < length $altalt) {
                 $alt = $altalt;
                 last getalt;
              }
           }

           if ($alt =~ m:/.+/:) {               # button/new.gif -> "button new"
              $alt =~ s{^(.*)/(.+)/(.*)$}{$2 $3}s ; 
           } elsif ($alt =~ m:./:) {
              $alt =~ s{^(.+)/(.*)$}{$2 $3}s ; 
           } else {
              $alt =~ s{^(.+)\b(\w+)$}{$2}s ;
           }
       }
       $alt =~ s/[ ]*$//sg ;
       $Args{"alt"} = $alt;
    }
    return "<img src="http://freespace.sourceforge.net/guidod/htm1-pp.1.1/build/etc/\&quot;$url\&quot;&quot;" . &getArgs() . ">";
}

# turn all spaces into &nbsp; ie. hardspace
# if text is empty, it will return exactly one &nbsp;
$Funcs{"nbsp"} = \&html_nbsp;
sub html_nbsp {
   my ($text) = @_;
   
   if (length $text) {
      $text =~ s/[ ]/\&nbsp\;/g ;
      return $text;
   } else {
      return "&nbsp;";
   }
}  

# -----------------------------------------------------------------
$Funcs{"some-code"} = \&html_some_code;
sub html_some_code {
   $_ = $_[0];
   s/<p >//sg ; # cut out soft-breaks, since we want to apply <pre> then
   
   $Args{"bgcolor"} = $Vars{"bgcolor2"} if (exists $Vars{"bgcolor2"});
   $Args{"bgcolor"} = $Args{"bgcolor2"} if (exists $Args{"bgcolor2"});
   $Args{"border"} = 1 if !exists $Args{"border"};
   $Args{"align"} = "center" if !exists $Args{"align"};
   $Args{"width"} = "80%" if !exists $Args{"width"};

   # transfer lines that look like real extra-comments
   s:(^)(\#\#.*)$:$1<font color=#00C000>$2</font>:mg ;
   
   return "<table ".&getArgs()."><tr><td><pre>$_</pre></td></tr></table>";
}

$Funcs{"c-code"} = \&html_c_code;
sub html_c_code {
   $_ = $_[0];
   s/<p >//sg ; # cut out soft-breaks, since we want to apply <pre> then

   # mark comments (at end of line, per line)
   s:(\/\*.*\*\/)(\s*)$:<small><i>$1</i></small>$2:mg ;
   # mark double-quotes
   s:(\&quot\;):<b>$1</b>:g ;
   # mark precompiler lines
   s:(^)(\#.*)$:$1<font color=#00C000>$2</font>:mg ;
   
   $Args{"bgcolor"} = $Vars{"bgcolor2"} if (exists $Vars{"bgcolor2"});
   $Args{"bgcolor"} = $Args{"bgcolor2"} if (exists $Args{"bgcolor2"});
   $Args{"border"} = 1 if !exists $Args{"border"};
   $Args{"align"} = "center" if !exists $Args{"align"};
   $Args{"width"} = "80%" if !exists $Args{"width"};
   
   return "<table ".&getArgs()."><tr><td><pre>$_</pre></td></tr></table>";
}

$Funcs{"td-code"} = \&html_td_code;
sub html_td_code {
   $_ = $_[0];
   s/<p >//sg ; # cut out soft-breaks, since we want to apply <pre> then
   
   $Args{"bgcolor"} = $Vars{"bgcolor2"} if (exists $Vars{"bgcolor2"});
   $Args{"bgcolor"} = $Args{"bgcolor2"} if (exists $Args{"bgcolor2"});
   return "<td ".&getArgs()."><pre>$_</pre></td>";
}

$Funcs{"td-c-code"} = \&html_td_c_code;
sub html_td_c_code {
   $_ = $_[0];
   s/<p >//sg ; # cut out soft-breaks, since we want to apply <pre> then

   # mark comments (at end of line, per line)
   s:(\/\*.*\*\/)(\s*)$:<small><i>$1</i></small>$2:mg ;
   # mark double-quotes
   s:(\&quot\;):<b>$1</b>:g ;
   # mark precompiler lines
   s:(^)(\# *\w*):$1<b>$2</b>:mg ;
   
   $Args{"bgcolor"} = $Vars{"bgcolor2"} if (exists $Vars{"bgcolor2"});
   $Args{"bgcolor"} = $Args{"bgcolor2"} if (exists $Args{"bgcolor2"});
   return "<td ".&getArgs()."><pre>$_</pre></table>";
}

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

@table_td = (""); 
@table_td_args = ("");

$Funcs{"tr-make"} = \&html_tr_make;
$Funcs{"tr_make"} = \&html_tr_make;
sub html_tr_make {
	($columns, $rep) = int ($_[0]);
        ($rep) = "\n<tr" . &getArgs() . ">" ;

	for $i (1 .. $columns) { 
           $rep .= "<td";
           $rep .= $table_td_args["$i"];
           $rep .= ">\n";
           $rep .= $table_td["$i"];
           $rep .= "\n</td>";
        }

        return $rep;
}

$Funcs{"td1"} = \&html_td1;
sub html_td1 {
	$table_td[1] = $_[0]; 
        $table_td_args[1] = &getArgs();  
        return "";
}

$Funcs{"td2"} = \&html_td2;
sub html_td2 {
	$table_td[2] = $_[0]; 
        $table_td_args[2] = &getArgs();
        return "";
}

$Funcs{"td3"} = \&html_td3;
sub html_td3 {
	$table_td[3] = $_[0]; 
        $table_td_args[3] = &getArgs();
        return "";
}

$Funcs{"td4"} = \&html_td4;
sub html_td4 {
	$table_td[4] = $_[0]; 
        $table_td_args[4] = &getArgs();
        return "";
}

$Funcs{"td5"} = \&html_td5;
sub html_td5 {
	$table_td[5] = $_[0];
        $table_td_args[5] = &getArgs();
        return "";
}

$Funcs{"td-clear"} = \&html_td_clear;
sub html_td_clear {
        for my $i (1..5) { $table_td[$i] = ""; $table_td_args[$i] = ""; }
        return "";
}

# -------------------------------------------------------------------
# transfer latin-spelled russian to koi8-r characters
# (beware to not put any other tags inside - the html-tags would 
#       be recoded as well and will probably not do what you want)
$Funcs{"ru"} = \&html_ru;
sub html_ru {
   my ($text) = @_;
   
   if (length $text) {
      $text =~ s/ja/\321/g ; # ja    (jalta)
      $text =~ s/Ja/\361/g ; 
      $text =~ s/JA/\361/g ; 

      $text =~ s/ju/\300/g ; # ju    (juri)
      $text =~ s/Ju/\340/g ; 
      $text =~ s/JU/\340/g ; 

      $text =~ s/([aeiouy\300\321])j/$1\312/g ; # ikratkoe   
      $text =~ s/([AEIOUY\340\361])[Jj]/$1\352/g ; 
      
      $text =~ s/j/\330/g ; # j (soft)    
      $text =~ s/J/\370/g ; 
      
      $text =~ s/scz/\335/g ; # shche     
      $text =~ s/Scz/\375/g ; 
      $text =~ s/SCZ/\375/g ; 
      
      $text =~ s/cz/\336/g ; # tche       
      $text =~ s/Cz/\376/g ; 
      $text =~ s/CZ/\376/g ; 

      $text =~ s/ch/\310/g ; # cha  (also as simple h) 
      $text =~ s/Ch/\350/g ; 
      $text =~ s/CH/\350/g ; 

      $text =~ s/kh/\310/g ;
      $text =~ s/Kh/\350/g ; 
      $text =~ s/KH/\350/g ; 
      
      $text =~ s/sc/\333/g ; # she
      $text =~ s/Sc/\373/g ; 
      $text =~ s/SC/\373/g ; 

      $text =~ s/sh/\333/g ; 
      $text =~ s/Sh/\373/g ; 
      $text =~ s/SH/\373/g ; 
      
      $text =~ s/sz/\326/g ; # zhe        
      $text =~ s/Sz/\366/g ; 
      $text =~ s/SZ/\366/g ; 

      $text =~ s/zh/\333/g ; 
      $text =~ s/Zh/\373/g ; 
      $text =~ s/ZH/\373/g ; 

      $text =~ s/eh/\334/g ; # open e
      $text =~ s/Eh/\374/g ; 
      $text =~ s/EH/\374/g ; 

      # transform them now, leave x untouched, transform v and w to same
      $text =~ y/a-pqr-uvwyz/\301-\320\337\322-\325\327\327\331\332/ ;
      $text =~ y/A-PQR-UVWYZ/\341-\360\377\362-\365\367\367\371\372/ ;
      
      $text =~ s/x//g ; # stop marker, put it where you want to 
                        # stop the above multichars from working
      return $text;
   } else {
      return "\336";
   }
   
   # try these:
   #     voskresenqe   (sunday) with a hard-sign
   #     sdelovatj     (doing)  with a soft-sign (as with all verbums)
   #     russkij       (russian) with an i-kratkoe at the end
   #     svobodnyj     (free) again, but with that ui-laut before
   #     vystupajusczij (speaker) including ju scz and i-kratkoe
   #     czelovek (people) czaj (tea)  szensczina szena (woman) 
   #     musz muszczina muszjja (husband man men)
   #     ehlektronika   (electronics)  v obqjatijach (in arms (embrace))
   #     ijunj ijulj    (june july)  justicija  ((dep. of) justice)
   #     poszalyjsta    (bitteschön)   socializm (...)
   #     technikum chimiczeskij (chemistry school)   christian (...)
}