#!/usr/bin/perl -w
# anders' html-table font bitmapping whiz-bang machine
# this one isn't even worth a GPL. consider this script
# in the public domain.
#
# although the font that it uses is probably copyrighted
# by derek powazek and that should be respected. get more
# information about the bitbet font at
# http://www.powazek.com/bitbet/
use strict;
use CGI qw/:standard/;
# this is the lookup table for the font. ugly to look
# at and not terribly cool, but it's the most efficient
# way to do it (cause, you know, efficiency is what we're
# after here. yup. you betcha)
my %map = (
a => [1,1,1,1,1,
1,0,0,0,1,
1,1,1,1,1,
1,0,0,0,1,
1,0,0,0,1],
b => [1,1,1,1,1,
1,0,0,0,1,
1,1,1,1,0,
1,0,0,0,1,
1,1,1,1,1],
c => [1,1,1,1,1,
1,0,0,0,0,
1,0,0,0,0,
1,0,0,0,0,
1,1,1,1,1],
d => [1,1,1,1,0,
1,0,0,0,1,
1,0,0,0,1,
1,0,0,0,1,
1,1,1,1,0],
e => [1,1,1,1,1,
1,0,0,0,0,
1,1,1,0,0,
1,0,0,0,0,
1,1,1,1,1],
f => [1,1,1,1,1,
1,0,0,0,0,
1,1,1,0,0,
1,0,0,0,0,
1,0,0,0,0],
g => [1,1,1,1,1,
1,0,0,0,0,
1,0,1,1,1,
1,0,0,0,1,
1,1,1,1,1],
h => [1,0,0,0,1,
1,0,0,0,1,
1,1,1,1,1,
1,0,0,0,1,
1,0,0,0,1],
i => [1,1,1,1,1,
0,0,1,0,0,
0,0,1,0,0,
0,0,1,0,0,
1,1,1,1,1],
j => [0,1,1,1,1,
0,0,0,1,0,
0,0,0,1,0,
1,0,0,1,0,
1,1,1,1,0],
k => [1,0,0,1,0,
1,0,0,1,0,
1,1,1,1,1,
1,0,0,0,1,
1,0,0,0,1],
l => [1,0,0,0,0,
1,0,0,0,0,
1,0,0,0,0,
1,0,0,0,0,
1,1,1,1,1],
m => [1,1,1,1,1,
1,0,1,0,1,
1,0,1,0,1,
1,0,0,0,1,
1,0,0,0,1],
n => [1,1,1,0,1,
1,0,1,0,1,
1,0,1,0,1,
1,0,1,0,1,
1,0,1,1,1],
o => [1,1,1,1,1,
1,0,0,0,1,
1,0,0,0,1,
1,0,0,0,1,
1,1,1,1,1],
p => [1,1,1,1,1,
1,0,0,0,1,
1,1,1,1,1,
1,0,0,0,0,
1,0,0,0,0],
q => [0,1,1,1,0,
1,0,0,0,1,
1,0,0,0,1,
1,0,0,1,1,
1,1,1,1,1],
r => [1,1,1,1,0,
1,0,0,1,0,
1,1,1,1,1,
1,0,0,0,1,
1,0,0,0,1],
s => [1,1,1,1,1,
1,0,0,0,0,
1,1,1,1,1,
0,0,0,0,1,
1,1,1,1,1],
t => [1,1,1,1,1,
0,0,1,0,0,
0,0,1,0,0,
0,0,1,0,0,
0,0,1,0,0],
u => [1,0,0,0,1,
1,0,0,0,1,
1,0,0,0,1,
1,0,0,0,1,
1,1,1,1,1],
v => [1,0,0,0,1,
1,0,0,0,1,
1,0,0,0,1,
0,1,0,1,0,
0,0,1,0,0],
w => [1,0,0,0,1,
1,0,0,0,1,
1,0,1,0,1,
1,0,1,0,1,
1,1,1,1,1],
x => [1,0,0,0,1,
1,0,0,0,1,
0,1,1,1,0,
1,0,0,0,1,
1,0,0,0,1],
y => [1,0,0,0,1,
1,0,0,0,1,
1,1,1,1,1,
0,0,1,0,0,
0,0,1,0,0],
z => [1,1,1,1,1,
0,0,0,0,1,
1,1,1,1,1,
1,0,0,0,0,
1,1,1,1,1],
' ' => [0,0,0,0,0,
0,0,0,0,0,
0,0,0,0,0,
0,0,0,0,0,
0,0,0,0,0],
'&' => [0,0,0,0,0,
0,0,1,0,0,
0,1,1,1,0,
0,0,1,0,0,
0,0,0,0,0],
'-' => [0,0,0,0,0,
0,0,0,0,0,
0,1,1,1,0,
0,0,0,0,0,
0,0,0,0,0],
'!' => [1,0,0,0,0,
1,0,0,0,0,
1,0,0,0,0,
0,0,0,0,0,
1,0,0,0,0],
'.' => [0,0,0,0,0,
0,0,0,0,0,
0,0,0,0,0,
0,0,0,0,0,
1,0,0,0,0],
'?' => [1,1,1,0,0,
0,0,1,0,0,
1,1,1,0,0,
0,0,0,0,0,
1,0,0,0,0],
'"' => [0,1,0,1,0,
0,1,0,1,0,
0,0,0,0,0,
0,0,0,0,0,
0,0,0,0,0],
"'" => [0,0,1,0,0,
0,1,0,0,0,
0,0,0,0,0,
0,0,0,0,0,
0,0,0,0,0]
);
# get parameters from the form
my $h_scale = param('width') || 1;
my $v_scale = param('height') || 1;
my $fore_color = param('foreground') || "#000000";
my $bg_color = param('background') || "#ffffff";
my $string = param('text') || "bitmapping a font with html tables";
# lowercase it.
$string =~ tr/A-Z/a-z/;
my @message = split //, $string;
print "Content-type: text/html\n\n";
print "test";
print "
\n";
print "";
# print the 'text'
foreach(@message) {
print "| ";
print_letter($_);
print " | \n";
}
print "
";
print "
\n
\n
\n
";
print "\n\n",
"font based on bitbet.
",
"(NOTE: you'll probably want to stick to real short",
" things since rendering those tables is a lot",
" of work for your browser.)
\n",
"if you care, and you don't mind seeing some messy perl, go ",
"ahead and check out the source code.
",
"if you tire of playing with this thing, you can go check out ",
"/dev/random.
\n";
print "\n";
# here's where we actually do shit.
sub print_letter {
my $letter = shift;
my $ref = $map{$letter};
return 0 unless defined($ref);
my @bits = @$ref;
my $width = $h_scale * 5;
my $height = $v_scale * 5;
print "";
foreach my $i (0..4){
print "";
foreach my $j (0..4) {
my $idx = 5 * $i + $j;
my $bg = $bits[$idx] ? "$fore_color" : "$bg_color";
print "";
print " ";
print " | ";
}
print "
";
}
print "
";
}