#!/usr/bin/perl -Tw

use strict;
use CGI ':standard';

use vars qw(
	@fonts
	%sizes
	%styles
);

my $q = new CGI;

my $param_scale = shift || $q->param("scale") || "rel-pt";
my $param_style = shift || $q->param("style") || "";
my $style_file = "fonts.css";

@fonts = (
	"Agency FB",
	"Arial",
	"Bell MT",
	"Book Antiqua",
	"Bookman Old Style",
	"Century Schoolbook",
	"Courier",
	"Courier New",
	"Franklin Gothic Book",
	"Garamond",
	"Georgia",
	"Gill Sans MT",
	"Goudy Old Style",
	"Haettenschweiler",
	"Helvetica",
	"Lucida Bright",
	"Lucida Console",
	"Lucida Sans",
	"MS Sans Serif",
	"Small Fonts",
	"Tahoma",
	"Terminal",
	"Times New Roman",
	"Trebuchet MS",
	"Verdana",
	"-",
	"serif",
	"sans-serif",
	"cursive",
	"fantasy",
	"monospace",
);

%sizes = (
	"abs" => {
		title	=> "Absolute",
		range	=> [
			"xx-small",
			"x-small",
			"small",
			"medium",
			"large",
			"x-large",
			"xx-large",
		],
		suffix	=> "",
	},
	"rel-pt" => {
		title	=> "Points (pt)",
		range	=> [ 8..10, 12, 13, 14, 16, 18, 24, 32 ],
		suffix	=> "pt",
	},
	"rel-px" => {
		title	=> "Pixels (px)",
		range	=> [ 9..14, 16, 18, 22, 24, 32 ],
		suffix	=> "px",
	},
);

%styles = (
	""	=> { style => "", title => "" },
	"b"	=> { style => "font-weight: bold", title => "Bold" },
	"i"	=> { style => "font-style: italic", title => "Italic" },
);



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

my @scale_range = @{$sizes{$param_scale}{range}};
my $scale_suffix = $sizes{$param_scale}{suffix};
my $scale_title = $sizes{$param_scale}{title};
my $style_css = $styles{$param_style}{style};
my $style_title = $styles{$param_style}{title};

my $text = "Lorem";
my $size_suffix = "";

my @fontdata;
foreach my $font (@fonts) {
	my $row;
	if ($font eq "-") {
		$row = Tr(td { colspan => @scale_range + 1 });
	} else {
		$row = Tr(
			{ style => "font-family: $font" },
			th($font),
			map {
				td({ nowrap => "nowrap", style => "font-size: $_$scale_suffix; $style_css" }, $text)
			} @scale_range
		);
	}
	push(@fontdata, $row);
}

my $title = "Font Chart: $scale_title" . ($style_title ? ", $style_title" : "");

print 	header(),
	start_html({
		-title => $title,
		# -head => Link({ -rel => "stylesheet", -href => "fonts.css" })
		-head => style({ -type => "text/css" }, read_stylesheet($style_file))
	}),
	h1($title),
	table({ cellpadding => 2 },
		Tr(th([ "", map { "$_$scale_suffix" } @scale_range ])),
		@fontdata
	);

sub	read_stylesheet {
	my ($file) = @_;

	open (local *F, "< $file") or die "open: $!";
	local $/ = undef;
	my $css = <F>;

	return $css;
}