#!/usr/bin/perl

#########################################################
#  MEGA MAN TEXT DISPLAY v 1.4                          #
#  BY DAVID BRADBURY                                    #
#                                                       #
#  Use in a form.  Supports both 'post' and 'get.'      #
#  Text is passed in the 'text' variable.               #
#  Size is passed in the 'size' variable.               #
#  Size is the pixel dimension (16 would show 16x16).   #
#                                                       #
#  view=source will show the source code                #
#                                                       #
#########################################################

print "Content-type:text/html\n\n";

parseform();

if ($form{'view'} eq "source"){
   #prints out the source
   
   open(CODE, "<text.cgi");

   print "<tt>\n";
   while (<CODE>){
      chomp($_);

      #turns HTML chars into HTML code (so source code won't be converted into working html)
      $_ =~ s/&/&amp\;/gi;
      $_ =~ s/>/&gt\;/gi;
      $_ =~ s/</&lt\;/gi;
      $_ =~ s/ /&nbsp\;/gi;
      $_ =~ s/\"/&quot\;/gi;

      $_ = $_ . "<br>\n";
      print $_;
   }
   print "</tt>\n";

   close(CODE);
   exit;
   
}


if (length($textstring)){
   displaytext();
}

controls();

if (!length($textstring)){
   displaystart();
}

exit;

sub parseform(){
   #read in data from get and post
   #doesn't matter if you use get or post in your forms, they'll both be read

   #get data from GET method
   @pairs = split(/&/, $ENV{'QUERY_STRING'});

   #for each name-value pair
   foreach $pair (@pairs) {

      #split the pair up into individual variables
      local($name, $value) = split(/=/, $pair);
 
      #decode the form encoding on the name and value variables
      $name =~ s/\0//g;  #stop poison nulls
      $name =~ tr/+/ /;
      $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      $name =~ s/<!--(.|\n)*-->//g;  #remove embedded ssi commands

      $value =~ s/\0//g;  #stop poison nulls
      $value =~ tr/+/ /;
      $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      $value =~ s/<!--(.|\n)*-->//g;  #remove embedded ssi commands

      $form{$name} = $value;

   }

   #get data from POST method
   read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
   @pairs = split(/&/, $buffer);

   #for each name-value pair
   foreach $pair (@pairs) {

      #split the pair up into individual variables
      local($name, $value) = split(/=/, $pair);
 
      #decode the form encoding on the name and value variables
      $name =~ s/\0//g;  #stop poison nulls
      $name =~ tr/+/ /;
      $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      $name =~ s/<!--(.|\n)*-->//g;  #remove embedded ssi commands

      $value =~ s/\0//g;  #stop poison nulls
      $value =~ tr/+/ /;
      $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      $value =~ s/<!--(.|\n)*-->//g;  #remove embedded ssi commands

      $form{$name} = $value;

   }

   $textstring = lc($form{'text'});
   $sizestring = lc($form{'size'});
   
   #remove anything other than 0-9 in size
   $sizetring =~ tr/0-9//cd;
   
}

sub controls(){
   print "<form action=\"\" method=\"get\">\n";
   print "<font size=\"1\">Enter text to display in Mega Man font here:<br>\n";
   print "<textarea name=\"text\" wrap=\"physical\" rows=\"4\" cols=\"50\">$textstring</textarea><br>\n";
   print "Size of text: </font>";
   print "<select name=\"size\">\n";
   print "<option value=\"8\">8</option>\n";
   print "<option value=\"12\">12</option>\n";
   print "<option value=\"16\" selected>16</option>\n";
   print "<option value=\"24\">24</option>\n";
   print "<option value=\"32\">32</option>\n";
   print "<option value=\"48\">48</option>\n";
   print "<option value=\"64\">64</option>\n";
   print "<option value=\"96\">96</option>\n";
   print "<option value=\"128\">128</option>\n";
   print "<option value=\"192\">192</option>\n";
   print "<option value=\"256\">256</option>\n";
   print "<option value=\"384\">384</option>\n";
   print "<option value=\"512\">512</option>\n";
   print "<option value=\"768\">768</option>\n";
   print "<option value=\"1024\">1024</option>\n";
   print "</select>\n";
   print "\&nbsp\;\&nbsp\;<input type=\"submit\" value=\"Submit\">\n";
   print "</form>\n\n";
}

sub displaystart(){
   print "<font size=\"1\">This page will display text in Mega Man 3 type.<br>\n";
   print "Enter some text in the text box and choose a text size.<br>\n<br>\n";
   print "<a href=\"?text=abcdefghijklmnopqrstuvwxyz%0D%0A";
   print "1234567890%0D%0A";
   print "+.%21%3F%3A%3B%2C%5C%27%A9&size=16\">View Supported Characters</a><br>\n<br>\n";
   print "<a href=\"?view=source\">View source code</a></font>\n";
}

sub displaytext(){
   
   #converts CRLF and LF to CR (standardized detection of new lines - now all I need to look for is \n :)
   $textstring =~ s/\r\n/\n/gi;
   $textstring =~ s/\r/\n/gi;
   
   for ($i = 0; $i < length($textstring); $i++){
      $new = substr($textstring, $i, 1);
      if ($new eq ' '){
         print "<img src=\"txt_spac.gif\" height=\"$sizestring\" width=\"$sizestring\">\n";
      }
      elsif ($new eq '.'){
         print "<img src=\"txt_per.gif\" height=\"$sizestring\" width=\"$sizestring\">";
      }
      elsif ($new eq '!') {
         print "<img src=\"txt_excl.gif\" height=\"$sizestring\" width=\"$sizestring\">";
      }
      elsif ($new eq '?') {
         print "<img src=\"txt_qtn.gif\" height=\"$sizestring\" width=\"$sizestring\">";
      }
      elsif ($new eq ':') {
         print "<img src=\"txt_coln.gif\" height=\"$sizestring\" width=\"$sizestring\">";
      }
      elsif ($new eq ';') {
         print "<img src=\"txt_scol.gif\" height=\"$sizestring\" width=\"$sizestring\">";
      }
      elsif ($new eq ',') {
         print "<img src=\"txt_coma.gif\" height=\"$sizestring\" width=\"$sizestring\">";
      }
      elsif ($new eq '\'') {
         print "<img src=\"txt_apos.gif\" height=\"$sizestring\" width=\"$sizestring\">";
      }
      elsif ($new eq '-') {
         print "<img src=\"txt_dash.gif\" height=\"$sizestring\" width=\"$sizestring\">";
      }
      elsif ($new eq '©') {
         print "<img src=\"txt_copy.gif\" height=\"$sizestring\" width=\"$sizestring\">";
      }
      elsif ($new eq "\n") {
         print "<br>\n";
      }
      else {
         #make sure the char exists before sending it to the browser (no broken images)
         #BTW: I use the crazy $ENV{'...'} stuff so I can hide the directory structure of the server
         if (-e "../../docroot" . substr($ENV{'DOCUMENT_URI'}, 0, -length($ENV{'DOCUMENT_NAME'})) . "txt_" . $new . ".gif"){
            print "<img src=\"txt_$new.gif\" height=\"$sizestring\" width=\"$sizestring\">";
         }
      }       
   }
}