|
Mega Man Text
Version 1.4 by David Bradbury
#!/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/&/&\;/gi;
$_ =~ s/>/>\;/gi;
$_ =~ s/</<\;/gi;
$_ =~ s/ / \;/gi;
$_ =~ s/\"/"\;/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 "\ \;\ \;<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\">";
}
}
}
}
|