#!/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 "\n"; } print "
"; print_letter($_); print "
"; print "
\n
\n
\n
"; print "\n
\n", "text: ", textfield(-name => 'text', -maxlength => 25), "
horizontal scaling: ", textfield(-name => 'width', -size => 2, -default => '1'), "
vertical scaling: ", textfield(-name => 'height', -size => 2, -default => '1'), "
foreground color: ", textfield(-name => 'foreground', -default => '#000000', -size => 7), "
background color: ", textfield(-name => 'background', -default => '#ffffff', -size => 7), "
\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.)

"; 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 "
"; }