#!/usr/bin/perl
#
#######################################################################
#
# MxScreen - Query compiler for MoxPerl MTG database
# 	     tchrist@mox.perl.com	
# 	     Sunday, 2 March 1998
#
#######################################################################
#
#   	``Lazy people never bother to actually read the manual.
#     	  Instead they (like kids) pick something with big,
#     	  colorful buttons.''
#    	    	--Eugene Tyurin <gene@insti.physics.sunysb.edu>
#
#   This program's mission in life is to allow non-programmers access to
#   the MoxPerl database.  This database is phenomenally powerful, but
#   since the queries must essentially be valid Perl programs, 99+% of
#   the MtG users out there fall on their faces writhing in mortal agony.
#   So we present shiny happy HTML form widgets that they can press and
#   scroll through with their shiny happy little mousey-mouses until
#   carpal tunnel syndrome sets in.  The goal, in short, is to compile
#   their widget selections in a proper Perl query for the database.
#
#   The v1 release of this query compiler was launched way back in 1995.
#   It suffered from having all possible choices on one form.  This was
#   extremely difficult to manage.  The v2 query compiler breaks up
#   this long form into tiny little pieces.  Each screen manages one
#   question area, like card name, casting cost, etc.  To link the
#   screens together, good old fashioned hidden fields are used to ensure
#   maximal portability.  Managing this is something of a 17-ring circus.
#   I don't think I could have done it without the standard CGI.pm module
#   written by Lincoln Stein and included in the standard Perl release.
#   It was designed for highly dynamic stateful forms, like this one.
#
#######################################################################

use strict;
use CGI qw(:netscape :cgi :form :html);

# The following chicanery predefines subroutines so we don't
# have to worry about using parens on our own function names.
# It's in a BEGIN{} so that it happens at compile time.
# It's a gratuitous hack because I'm too lazy to keep updating
# the function list or to remember to use parens for everything,
# especially functions.
BEGIN {
    my @sublist;
    if (open(THIS_SCRIPT, "< $0")) {
	while (<THIS_SCRIPT>) { push @sublist, $1 if /^[*\s]*sub (\w+)/ }
	eval q{ use subs @sublist } if @sublist; # delayed eval needed here
	close THIS_SCRIPT;
    }
}

# Global variable declaration, set in inits below
use vars (

    qw{ $CUR_VERSION	    },	    # internal version number
    qw{ $DEBUG		    },	    # whether we're debugging

    qw{ $SORT_LEVELS	    },	    # how many sort choices to give
    qw{ $SERVER_PATH	    },	    # Unix-domain socket to database server
    qw{ $LOGFILE	    },	    # where to log little traces

    qw{ %State_Table 	    },	    # maps screen names to function calls
    qw{ $State		    },	    # current screen name
    qw{ %Query		    },	    # meta info about current query
    qw{ $Cannot_Do_Selections },    # MSIE broken browser
    qw{ $Was_Mapclick       },      # did they click on the card picture?

    qw{ $Bad_Login          },	    # Did they give a bogus mail addr
    qw{ $Return_Cookie      },	    # To send back in header

);

initialize();
manage_screens();
exit(0);

#################################

sub initialize {

    # 	This should be in RCS, but it doesn't like thousands places.
    $CUR_VERSION = "2.022";

    # 	give four sort levels.  easy to add more.  should
    # 	make it a settable by the user.
    $SORT_LEVELS = 4;

    # 	where our logmessages go
    $LOGFILE 	 = "/tmp/nmx.log";

    # 	Path to Unix-domain socket over which we talk to
    # 	the real database server
    $SERVER_PATH = "/tmp/MTG-public-sock";

    # No debugging info turned on.
    $DEBUG = 0;

    # Assume it's ok
    $Cannot_Do_Selections = 0;

    # Assume didn't hit picture
    $Was_Mapclick = 0;

    $Bad_Login     = '';
    $Return_Cookie = '';

##########################################################################
#
#   This %State_Table hash is the heart of the whole program.  The hash
#   keys are the current screen name, which will be used button labels
#   (generally, but search for "Revise Query" below).  The hash values
#   are (references to) the functions to call.  There are two kinds:
#   selection buttons (those whose functions' names start with choose_)
#   and everything else.  These two kinds are displayed in two different
#   rows.  The current screen's button never displays for itself.
#
##########################################################################

    %State_Table = (
	Initial	 => \&show_top,

	Execute  => \&run_query,
	Format   => \&get_format,
	Login    => \&resister_login,
	Review   => \&review_selections,
	Sorting  => \&get_sorting,
	Wizard   => \&wizards_only,

	Ability	 => \&choose_ability,
	Artist	 => \&choose_artist,
	Class	 => \&choose_class,
	Color	 => \&choose_color,
	Cost	 => \&choose_cost,
	Flavor 	 => \&choose_flavor,
	Name 	 => \&choose_name,
	Power	 => \&choose_power,
	Rarity	 => \&choose_rarity,
	Release	 => \&choose_release,
	Ruling	 => \&choose_ruling,
	Restriction => \&choose_restriction,
	Text 	 => \&choose_text,
	Toughness=> \&choose_toughness,
	Type	 => \&choose_type,

    );

    # I'm tired of idiots who won't use the fuzzy matcher.
    $State_Table{Card} = \&choose_card if is_privileged();

###################################################################
#
#   The following enums are very important to the screen dispatcher.
#   Screen functions called with HIDDEN are expected to output
#   any information as hidden widgets only.  Those called with
#   DISPLAY should display everything: they are the active screen.
#   When called with CODEGEN, the screen function is expected to
#   return a bit of Perl code that can be passed to the query
#   compiler backend database server.  All screen selections
#   are and'ed together, so each screen is a further refining.
#   Only functions called with CODEGEN have return values that
#   are paid attention to.

#
    use constant SCREEN_HIDDEN    => 0;	# hidden widgets from passive screens
    use constant SCREEN_DISPLAY   => 1;	# full output for active screen
    use constant SCREEN_CODEGEN   => 2;	# compile widgets to perl code
#
#   These are actually defined at compile time ("use constant"
#   is a compiler pragma, not an interpreter command.).  There
#   are located here for easy updates, should this prove necessary.
#
###################################################################

    # 	Determine our current screen, defaulting to "Initial"
    # 	the first time called.  The funny business about Review
    #   is because of the login button's <CR> form entry doesn't
    #   trigger a state button.
    determine_state();

    # 	Autoflush STDOUT.  Doesn't help a great deal, though,
    # 	since we're not running in non-parsed header mode, so the
    # 	darned server will still grab everything.

    $| = 1;

    # 	This one is so every print statement has an extra
    # 	newline at the end, thus producing more <VIEW SOURCE>able
    # 	HTML output.

    $\ = "\n";

    #	Load in the STDERR intercepter for logging message,
    #   and point it either back to our own standard output
    #   if we're debugging, or else to the logfile, which we
    #   sure hope we remembered to make world-writable.

   use CGI::Carp;
   use CGI::Carp qw(fatalsToBrowser);

    if ($DEBUG || (-t STDIN && -t STDOUT)) {
	CGI::Carp::carpout(\*STDOUT)
    } else {
	local *FH;  # only way to make locally scoped handles
	if (open(FH, ">> $LOGFILE")) {
	    select((select(FH), $| = 1)[0]);  # autoflush
	    CGI::Carp::carpout(\*FH)
	} else {
	    carp("can't append to $LOGFILE: $!");
	}
    }

    check_registration();

    # redirect to the fuzzy matcher if they only want a name
    redirect_name_query() if $State =~ /Execute|Name/i;

    # 	output MIME header; before this, all roads lead to SERVER 500 ERRORS
    # 	Any set-cookie requests would go here.
    if ($Return_Cookie) {
	print header(-COOKIE => $Return_Cookie);
    } else {
	print header();
    }

}

############################################################################
# Figure out what state we're in.  
#   0) The first time, there is so state, so set it to 'Initial'.
#   1) Usually we got that way because they pushed a submit button named
#      'state'.  That button's value is the next state to jump to.
#   2) The card is an input button with mapped coordinates.
#      If it was clicked, build the CGI::Imagemap object to get the state.
#   3) They might have accidentally hit the <CR> in the 
#      login screen, which only has one textfield widget, so 
#      there would be no state.  Pretend they hit Review.
#   4) The clever user might have used an inital call like 
#	   http://mox.perl.com/cgi-bin/MxScreen?state=Color
#      Because of the way the library works, this is virtually 
#      indistinguishible from case 1.  But that's ok.
############################################################################
sub determine_state {
    if ($State = get_param("state")) {

	# 	The "Refine Query" state is an alias used
	# 	in the Execute (run query, get output) screen.
	$State = "Review" if $State eq 'Refine Query';

	# 	The "Expert" state is an alias used
	# 	to scare off the weenie looking for some
	#       artificial intelligence beastie
	$State = "Wizard" if $State eq 'Expert';

	return;
    } 

    unless (length(get_param("cardgif.x"))) {
	# this means they hit <Enter> on the Login screen
	#$State = (param() != 0) ? "Review" : "Initial";
	$State = "Initial";
	return;
    } 

    $Was_Mapclick = 1;

    require CGI::Imagemap;

    my ($x, $y, $map, @mapdata, $action);

    $x = param('cardgif.x');
    $y = param('cardgif.y');

    ########################################################################
    # the following coordinates were figured out by using the very fine
    # xv command.  there are probably better ways, but this one was free
    # and i didn't have to delete my operating system to use it.
    #
    @mapdata = map { /(\S.*\S)/ } split /\n/, 
	#   STATE       SIZE      START
	#   ---------   ------    ---------
						<<EO_MAPDATA;
	    Name	88x39  	@ 0,0 
	    Card	118x91  @ 23,27
	    Cost	89x45   @ 89,0
	    Release     37x35   @ 124,115
	    Class	108x16  @ 0,126
	    Ability     130x19 	@ 0,141
	    Text	160x23  @ 0,161
	    Flavor      161x26  @ 1,181
	    Artist      93x228  @ 1,209
	    Power       19x35   @ 130,196
	    Toughness   15x35   @ 147,196
EO_MAPDATA

    $map = CGI::Imagemap->new;

    $map->addmap("default Color");

    for (@mapdata) {
	my ($name, $x_width, $y_length, $start_x, $start_y, $end_x, $end_y);
	next unless ($name, $x_width, $y_length, $start_x, $start_y) 
		    = /(\S+)\s+(\d+)x(\d+)\s+\@\s+(\d+),(\d+)/;
	# unregistered users don't get the card screen because they're
	# too dim to use it.  let them go to all the different places
	# instead.
	next if $name =~ /Card/ && isn't_registered();
	$end_x = $start_x + $x_width;
	$end_y = $start_y + $y_length;
	$map->addmap("rect $name $start_x,$start_y $end_x,$end_y");
    }

    $State = $map->action($x,$y) || 'Color';

}

###############################################
# make some colored makers
# this generates functions of named after the colors
BEGIN {
    no strict 'refs';
    for my $color (qw[red yellow orange green blue purple violet]) { 
	*$color = sub { qq<<FONT COLOR="\U$color\E">@_</FONT>> };
    }
    # the following aliasing is because I wanted yellow/green/red like
    # traffic semaphores, but on systems where you let your bg colors
    # override mine, if you have a yellow bg chosen, you can't read
    # the yellow buttons very well.
    undef &yellow;  # silence -w
    *yellow = \&purple; 
} 

sub poker { submit(-NAME => "state", -VALUE => "@_") } 
sub flash { qq[<FLASH>@_</FLASH>] }

###################################################################
# Main driver function to handle all the screens.
# Call the current screen with DISPLAY, the rest
# with HIDDEN.
######################################################################
sub manage_screens {
    my $action  = $State_Table{$State} || $State_Table{ucfirst(lc($State))};
    panic("Unknown action: [$State]") unless $action;

    if ($State eq 'Execute') {
	banner("Query Compiler Output");
	action_button_row();
    } else {
	banner("$State Selection");
    }

    tracelog(get_user_query());

    if ($Bad_Login) {
	oops "Your login, $Bad_Login, does not appear to be a valid mail address.";
    }

    # Run through all states: DISPLAY current, HIDDEN others
    #
    foreach my $state (sort keys %State_Table) {
	next if $state eq 'Name' && isn't_privileged() && $Query{Count} == 0;
	my $function = $State_Table{$state};
	my $how = ($action == $function)
		    ? SCREEN_DISPLAY
		    : SCREEN_HIDDEN;
	$function->($how);
    }

    if ($State !~ /Execute/) {
	selection_buttons();
	unless(get_param('login') || $State =~ /Login|Execute/) { 
	    print p( "Please select the", 
		     yellow(poker("Login")),
		     "button to register for",
		     flash(purple(("special privileges.")))); 
	}
    }

    action_button_row() unless $State =~ /Initial|Execute/; #  || !get_user_query();

    print "</DL>";
    print end_form();  # no more widgets allowed
    dump_query() if $DEBUG;
    show_trailer();
    print end_html();
}

######################################################################
# Print out top row of buttons.
#
# Non-programmers don't get the Execute button
# until they've visited the Review page, because otherwise they 
# end up generating a lot of code without realizing what they're 
# doing all because of the all the mad clicking.
######################################################################
sub action_button_row {
    my $his_query = get_user_query();

    # because the Prisoners of Bill don't understand
    # that a wizard button is for wizards only!
    ## my $wizname = is_programmer() ? "Wizard" : "Expert";
    my $wizname = "Wizard";

    print "<CENTER>";   # I'll probably be hated for the netscapism
    print "<HR>";

    if ($State !~ /Execute|Review/) { 
	print "To <B>run</B> your query, you ", 
	    is_programmer() ? " should " : " must ",
	    "first visit the Review screen. <BR>"
    } 

    if ($State ne 'Execute') {

	for (qw(Review Execute Format Sorting Login), $wizname) {
	    print "<BR>" if /Format/;
	    next if $State eq $_;  # No button for current
	    next if isn't_programmer() && !$his_query && /Execute/;
	    # make them review before submitting
	    if (/Execute/) {
		if ($State ne 'Review' && isn't_programmer()) {
		    next;
		}
	    }

	    if (/Execute|Review/) {
		print green(poker($_));
	    } else {
		print yellow(poker($_));
	    }
	}
		
	print "<BR>";
	print orange(reset("Undo")) unless $State eq 'Initial';
	print red(defaults("Abandon Query"));
	print p("Download full sourcecode for ", 
		a({href => "/deckmaster/admin/MxScreen" },  "Query Compiler"),
		"(" . get_my_size() . ")") if is_privileged();

    } else {
	print green(poker("Refine Query"));
	print red(defaults("New Query"));
    }

    print "</CENTER>";
}

######################################################################
# Print out selection buttons.
sub selection_buttons {

    my $cardname = pick_a_pic();

    my $sitedir = "http://www.wizards.com/Magic/images/Full_Cards";
    #my $sitedir = "file:/deckmaster/gifs/cards";
    print <<EO_TABHDR;
<P><HR>
<TABLE NOBORDER ALIGN=CENTER>
EO_TABHDR

    print <<'EOTABLE';
    <TR><TD><SMALL>Either click on the particular region of 
		this card related to your query...</SMALL>
        <TD><SMALL> ...or else read this <A
HREF="/deckmaster/info/screen-buttons.html">explanation</A> to learn
what all these buttons actually do.
    </SMALL></TR>
EOTABLE

    print <<EO_TABHDR;
<TR> <TD ALIGN=CENTER> <INPUT TYPE=IMAGE NAME="cardgif"
     SRC="$sitedir/$cardname" HEIGHT=231 WIDTH=162>
</TD>

<TD ALIGN=CENTER>
<CENTER>
EO_TABHDR


    foreach my $state (sort keys %State_Table) {
	next if $state eq $State;
	next unless is_selection($state);
	print blue(poker($state))
	    unless $state eq 'Name'    # because they should use mr fuzzy
		&& isn't_privileged() 
		&& $Query{Count} == 0;
    }

    print "</CENTER></TD></TR>";

    print "</TABLE>";

}

######################################################################
#   First all the Screen managers.
#
#   Screen managers called with HIDDEN are expected to output
#   any information as hidden widgets only.  Those called with
#   DISPLAY should display everything: they are the active screen.
#   When called with CODEGEN, the screen function is expected to
#   return a bit of Perl code that can be passed to the query
#   compiler backend database server.  All screen selections
#   are and'ed together, so each screen is a further refining.
#   Only functions called with CODEGEN have return values that
#   are paid attention to.
#
# There are several general kinds of selection screens.
# They each print their own message and then call one of three
# general-purpose screen managers.
#
#     1) Those that call meta_select() to include and/or exclude
#	 a bunch of selections from one list.
#
#     2) Those that call meta_match() to match arbitrary
#        strings or patterns.
#
#     3) Those that call meta_numeric() to perform a numeric
#	 or quasi-numeric match.
#
# A few special purpose choose screens also exist, like Wizard and Login.
###########################################################################


#####################
# SCREEN: "Initial" #
#####################
sub show_top {
    my $visible = shift;

    return unless $visible == SCREEN_DISPLAY;

    my $who;
    if ($who = get_param('login')) {
	$who =~ s/^/Welcome back, /;
    } else { 
	$who = "Welcome, " 
	     . (rand(10) < 2)
		? (is_programmer() ? "mighty programmer" : "happy user")
		: (is_programmer() ? "fellow programmer" : "user"      );
    }

    print <<"EO_INTRO";
<P>$who, to the multi-screen version of the MoxPerl Query Compiler.
Please report <A HREF="mailto:tchrist\@mox.perl.com?subject=MoxPerl Feedback">any problems</A>
you find in it.  Don't forget about the programmers' interface for direct
access to the <A HREF="/deckmaster/forms/mx-backend.html">real MoxPerl</A>
database, the <A HREF="/deckmaster/cards/">Fuzzy Matcher</A> for simple
card-name lookups, and <A HREF="/deckmaster/forms/angelgrep.html">Angel
Grep</A> for simple rulings queries.
EO_INTRO

    my $size = get_my_size();

    print qq{

<P>In the spirit of the freeware community, programmers may wish to
fetch this program's <A HREF="/deckmaster/admin/MxScreen">complete
source code</A> ($size) as an example of a complex shopping-cart
application using nothing but pure Perl and basic HTML.

<P>This graphical interface is but a palimpsest of the
real MoxPerl.  For a glimmer of the awesome possibilities that
await the curious and resourceful, check out the <b>updated</b> and
<B>ultra-cool</B> @{[yellow(poker("Wizard"))]} screen.

    };

    broken_browser();

    if ($Cannot_Do_Selections || (isn't_programmer() && rand(10) < 2)) {
	print q{<P>I don't suppose that I might interest you in a
<A HREF="http://www.linux.org/">system upgrade</A>
to replace your <A HREF="http://mox.perl.com/cgi-bin/bados">current system</a>?
<IMG SRC="/deckmaster/gifs/smiley.gif" ALT="just kidding">  }
    }


}

####################
# SCREEN: "login"
####################
sub resister_login {
    my $visible = shift;

    return if $visible == SCREEN_CODEGEN;

    if ($visible == SCREEN_HIDDEN) {
	print hidden('login') if get_param('login');
	return;
    }

    return unless $visible == SCREEN_DISPLAY;

    print p(strong("Don't hit carriage return -- read the whole thing first!"));
    print center(p("Your mail address: ",
	    textfield(-NAME => "login", -SIZE => 30))
    );

    print <<EOM;
<P>This screen allows you to register a mail address.  While registration
is <b>entirely optional</b>, registered users do enjoy greater access
privileges:
<UL>
<LI>have a more &aelig;sthetically appealing background color
<LI>get rotating card graphics
<LI>can invoke advanced pattern-matching features
<LI>can launch queries of unlimited return size (once they find the Easter Egg)
<LI>gain access to the special wizards-only screen and the full-card screen.
</UL>
Time and interest permitting, I could in theory even exchange
helpful mail with you about the engine.

<P>You see, I can only permit a portion of the cards to be
retrieved at one time, at least by default.  This is because
too often users accidentally make bad queries that test true
for all possible cards and then end up needlessly downloading <A
HREF="http://language.perl.com/mox/expanded-dbase.pl.gz">the whole
database</a> in one shot.  This really kills my modem connection!
By allowing these mass downloads only for privileged users, it cuts down
on the accidents.  

<P>Only privileged users are allowed to find the magical Easter Egg that
allows mass downloads, which is semi-hidden on one of the more obscure
screens (not this one).  In the future, I may provide an option to have
the database mail you the output of long queries instead of aborting
the transfer.

<P>One way to become privileged is to register your mail
address; accountability reduces abuse.  For other ways, you'll just have to read the source code
<IMG SRC="/deckmaster/gifs/smiley.gif" ALT=":-)">.

<P>
Your address will <I>never</I> be used for spamming (bulk unsolicited
commercial email) purposes, and will be held in strict confidence.
It is stored as a hidden field on these screens for the duration of the
transaction, and if you permit it, as a cookie on your browser.   You may
alter or delete your registration at any time.

EOM

}


############################################
# SCREEN: Both "Review" and "Revise Query" #
############################################
sub review_selections {
    my $visible = shift;
    return unless $visible == SCREEN_DISPLAY;
    dump_query();
    color_check();
}


###################
# SCREEN: "Power" #
###################

sub choose_power {
    my $visible = shift;
    my @values = qw(toughness * 0 1 2 3 4 5 6 7 8 9); # 10 11 12

    print "<P>A creature's power is the left-hand number at the
    bottom left of the card.  It's its attack value. 
    And a `<tt>*</tt>' doesn't mean any old power; it means a real star on the card.
    <P>"
	if $visible == SCREEN_DISPLAY;

    meta_numeric( NAME    => "Power",
	       VISIBLE => $visible,
	       VALUES  => \@values,
	     );
	
}

#######################
# SCREEN: "Toughness" #
#######################
sub choose_toughness {
    my $visible = shift;
    my @values = qw(power * 0 1 2 3 4 5 6 7 8 9); # 10 11 12

    print "<P>A creature's power is the right-hand number at the
    bottom left of the card.  It's its defense value.
    And a `<tt>*</tt>' doesn't mean any old toughness; it means a real star on the card.
    <P>" if $visible == SCREEN_DISPLAY;

    meta_numeric( NAME    => "Toughness",
	       VISIBLE => $visible,
	       VALUES  => \@values,
	     );

}

##################
# SCREEN: "Cost" #
##################
sub choose_cost {
    my $visible = shift;
    my @values = qw(X 0 1 2 3 4 5 6 7 8 9 10 11 12);

    if ($visible == SCREEN_DISPLAY) {
	print qq{
	    <P>This checks a card's total numeric casting cost, without
	    respect to any colors.  If you are about which colors are
	    involved in the casing cost, you may instead want to make
	    sections from the @{[blue(poker("Color"))]} screen,
	    or combine those with this screen.<P>
	};

    }

    meta_numeric( NAME    => "Cost",
	          VISIBLE => $visible,
	          VALUES  => \@values,
	     );

}

######################################################
# Manage all numeric screens
######################################################
sub meta_numeric {
    my %parm = @_;

    my $widname  = $parm{NAME};
    my $visible  = $parm{VISIBLE};
    my $valref   = $parm{VALUES};

    panic "$widname called voidly!" if $visible == SCREEN_CODEGEN && !defined wantarray;

    unshift(@$valref, "Don't Care");

    my @compares = map { /(\S.*\S)/ } split "\n" =><<EOLIST;
			 equal
			 not equal
			 less than
			 less than or equal
			 greater than
			 greater than or equal
			 contain
			 doesn't contain
EOLIST

    my %operators = (
	 'equal'		    => 'eq',
	 'not equal'		    => 'ne',
	 'less than'		    => '<',
	 'less than or equal'	    => '<=',
	 'greater than'		    => '>',
	 'greater than or equal'    => '>=',
	 'contain'		    => '=~',
	 'doesn\'t contain'	    => '!~',
    );

    if ($visible == SCREEN_DISPLAY) {

	print "<DL>";
	print dd("$widname must be ",
	    popup_menu( -NAME   => "$widname cmp 1",
			-VALUES => \@compares,
			-DEFAULT => 'equal'),
	    " to ",
	    popup_menu( -NAME   => "$widname against 1",
			-DEFAULT => 'equal',
			-VALUES => $valref),
	);

	print p();
	print dt( popup_menu(
	    -NAME    => "$widname conj",
	    -VALUES  => [ "and also", "or else" ],
	    -DEFAULT => "and also",
	));

	print dd("$widname must be ", popup_menu(
	    -NAME   => "$widname cmp 2",
	    -DEFAULT => 'equal',
	    -VALUES => \@compares),
	    " to ", popup_menu(
	    -NAME   => "$widname against 2",
	    -DEFAULT => 'equal',
	    -VALUES => $valref,
	));

	print "</DL>";

    }
    elsif ($visible == SCREEN_HIDDEN) {
	my $against1 = get_param("$widname against 1");
	my $against2 = get_param("$widname against 2");

	if (length($against1) && $against1 ne "Don't Care") {
	    print hidden(-NAME => "$widname cmp 1");
	    print hidden(-NAME => "$widname against 1");
	}

	if (length($against1) && length($against2) &&
	    $against1 ne "Don't Care" && $against2 ne "Don't Care")
	{
	    print hidden(-NAME => "$widname conj");
	}

	if (length($against2) && $against2 ne "Don't Care") {
	    print hidden(-NAME => "$widname cmp 2");
	    print hidden(-NAME => "$widname against 2");
	}
    } elsif ($visible == SCREEN_CODEGEN) {
	my $cmp1     = get_param("$widname cmp 1");
	my $cmp2     = get_param("$widname cmp 2");
	my $against1 = get_param("$widname against 1");
	my $against2 = get_param("$widname against 2");
	my $conj     = get_param("$widname conj");

	my ($str1,$str2) = ('', '');
	my $widf = uc($widname);

	#####################################
	# this is all a terrible hack
	# that i've patched in to make things
	# work better for now.  it needs a rethink.
	#####################################

	sub fix_op {
	    my($operator, $operand) = @_;
	    if ($operator =~ /=$/) {
		return $operator if $operand =~ /^\d+/;
		oops "Relative comparison $operator useless with $operand"
		    unless $operator =~ /^[!=]=$/;
		my $newop = {
		    '==' => 'eq',
		    '!=' => 'ne',
		    '>=' => 'ge',
		    '>'  => 'gt',
		    '<=' => 'le',
		    '<'  => 'lt',
		    '=~' => '=~',
		    '!~' => '!~',
		}->{$operator} || "MISSING OPERATOR";
		return $newop;
	    } else {
		#@oops "return $operator due to $operand";
		return $operator;
	    }
	}

	sub fix_targ {
	    my ($op, $what) = @_;
	    if ($op =~ /^[netlq]{2}$/ && $what =~  /^[*X]$/) {
		return qq("$what");
	    }
	    #if ($op eq '=~') { return quotemeta($what); }
	    return $what;
	}


	if (length($against1) && $against1 ne "Don't Care") {
	    my $op = fix_op($operators{$cmp1}, $against1);
	    my $wid = $widf;
	    $wid = 'NCOST' if lc $wid eq 'cost' && $against1 =~ /^\d+$/;
	    my $targ = fix_targ($op, $against1);
	    $str1 = "(length($wid()) && $wid() $op $targ)"
	}
	if (length($against2) && $against2 ne "Don't Care") {
	    my $op = fix_op($operators{$cmp2}, $against2);
	    my $wid = $widf;
	    $wid = 'NCOST' if lc $wid eq 'cost' && $against2 =~ /^\d+$/;
	    my $targ = fix_targ($op, $against2);
	    $str2 = "(length($wid()) && $wid() $op $targ)"
	}

	my $string = '';
	if ($str1 && $str2) {
	    $string =  "(" .
			join($conj =~ /and/ ? " and " : " or ", $str1, $str2)
			. ")";
	} else {
	    $string = $str1 || $str2;
	}
	for ($string) {
	    s/power/POWER()/g;
	    s/toughness/TOUGHNESS()/g;
	    s{~ ([^\s()]+)}{~ m{$1}}g;
	    s/\*/\\*/g;
	}
	return $string;
    }

}

###################
# SCREEN: "Color" #
###################
#
# 	   	   	   	       And who are you?
# 
#Color       Friends         Foes            Attributes
#-----       ------------    -----------     ------------
#Black       Red, Blue       White, Green    death and decay and discard
#Red         Green, Black    Blue, White     destruction and chaos and fire
#White       Green, Blue     Black, Red      order and protection and healing
#Green       White, Red      Black, Blue     mana and life and growth
#Blue        White, Black    Green, Red      manipulation and control and magic

sub choose_color {
    my $visible  = shift;
    my $widname  = "Color";
    my @namelist = qw(white green blue red black gold colorless);
    my %labels = (
	'white'	 => '<IMG SRC="/deckmaster/gifs/w.gif" ALT="white">',
	'blue'	 => '<IMG SRC="/deckmaster/gifs/u.gif" ALT="blue">',
	'black'	 => '<IMG SRC="/deckmaster/gifs/b.gif" ALT="black">',
	'green'	 => '<IMG SRC="/deckmaster/gifs/g.gif" ALT="green">',
	'red'	 => '<IMG SRC="/deckmaster/gifs/r.gif" ALT="red">',
    );

    if ($visible == SCREEN_DISPLAY) {
	print <<'END_of_Color_Info';
    <P> If you just want all of one particular color, please see the <a
    href="/deckmaster/cards/Canned.html">Canned Listings</a> for pre-made
    lists.  
    <P>
    Remember that Magic has only five colors.  Gold is
    slang for `more than one different color in the casting cost',
    colorless for `having zero colors in the casting cost'.
    <P>Most nonsensical queries will be nipped in the bud.

END_of_Color_Info


print <<'END_of_Color_Info' if 0;
    <P>Suppose you want red cards that don't have other colors in them.
    Select <tt>red</tt> from the <I>inclusion menu</i>, and then select
    <tt>gold</tt> from the <i>exclusion</i> one.  Don't bother choosing
    anything else from the second one.  Asking for <tt>red and not (gold
    or blue or green or white or black or colorless)</tt> is unnecessarily
    wasteful, and makes very little sense.  A red card that isn't gold
    is <i>guaranteed</i> to not be blue or green or white or black.  And of course,
    no cards of any color can also colorless, so asking for red and not colorless
    is also nonsense.  

END_of_Color_Info

	color_check();

    }

    autoEscape(undef) if $visible == SCREEN_DISPLAY;

    my @ret = meta_select(  	VISIBLE => $visible,
			      NAME    => $widname,
			      WIDGET  => \&checkbox_group,
			      LABELS  => \%labels,
			      NAMES   => \@namelist,
			      COLS	  => scalar(@namelist),
    );

    autoEscape(1) if $visible == SCREEN_DISPLAY;

    return @ret if @ret;
}

#########################
# SCREEN: "restriction" #
#########################
sub choose_restriction {
    my $visible  = shift;
    my $widname  = "Restriction";
    my (@namelist, %labels);
    # left hand side of hash is code to pass to MoxPerl.
    # labels displayed are what is in rhs.
    # keep both to preserve ordering, which is lost in the hash.
    %labels = @namelist = (

	    standard_legal	=> "Legal in Standard",
	    classic_legal	=> "Legal in Classic",
	    classicR_legal	=> "Legal in Classic-Restricted",
	    extended_legal	=> "Legal in Extended",

	    standard_restricted	=> "Restricted in Standard",
	    classic_restricted	=> "Restricted in Classic",
	    classicR_restricted	=> "Restricted in Classic-Restricted",
	    extended_restricted	=> "Restricted in Extended",

	    standard_banned	=> "Banned from Standard",
	    classic_banned	=> "Banned from Classic",
	    classicR_banned	=> "Banned from Classic-Restricted",
	    extended_banned	=> "Banned from Extended",

    );

    # reduce namelist array to just odd elements; hash has both
    my $i = 0;
    @namelist = grep { ++$i & 1 } @namelist;

    if ($visible == SCREEN_DISPLAY) {
	print qq{This screen selects for
	<A HREF="http://www.wizards.com/MTG_restriction/Welcome.html">DCI</A>
	tournament applicability.  Note that <A HREF="/deckmaster/cards/ST.html">Stronghold</a>
	is not quite legal in standard tournaments yet, but is now included in the <A
	HREF="/deckmaster/cards/TypeII-legal.html">Type II
	legal</A> (200k download) selection.};
    }

    meta_select(  VISIBLE => $visible,
		  NAME    => $widname,
		  WIDGET  => fix_msie_lists(),
		  NAMES   => \@namelist,
		  LABELS  => \%labels,
    );

}

####################
# SCREEN: "Rarity" #
####################
sub choose_rarity {
    my $visible  = shift;
    my $widname  = "Rarity";
    my (@namelist, %labels);
    # left hand side of hash is code to pass to MoxPerl.
    # labels displayed are what is in rhs.
    # keep both to preserve ordering, which is lost in the hash.
    %labels = @namelist = (
       "rare" => "rare",
       "uncommon" => "uncommon",
       "common" => "common",
       #"RARITY() =~ /L/" => "land",
    );
   # reduce namelist array to just odd elements; hash has both
   my $i = 0;
   @namelist = grep { ++$i & 1 } @namelist;
    meta_select(  VISIBLE => $visible,
		  NAME    => $widname,
		  WIDGET  => \&checkbox_group,
		  NAMES   => \@namelist,
		  LABELS   => \%labels,
    );
}

#####################
# SCREEN: "Ability" #
#####################
sub choose_ability {
    my $visible  = shift;
    my $widname  = "Ability";
    my (@namelist, %labels);
    # left hand side of hash is code to pass to MoxPerl.
    # labels displayed are what is in rhs.
    # keep both to preserve ordering, which is lost in the hash.
    %labels = @namelist = (
       "flying" 	=> "Flying",
       "first_strike" 	=> "First Strike",
       "regenerates" 	=> "Regenerates",
       "trampling" 	=> "Trampling",
       "rampage" 	=> "Rampage",
       "banding" 	=> "Banding",
       "phasing" 	=> "Phasing",
       "flanking" 	=> "Flanking",
       "shadow"		=> "Shadow",
       "protection" 	=> "Protection",

       "landwalk" 	=> "Landwalk",
       "forestwalk" 	=> "Forestwalk",
       "islandwalk" 	=> "Islandwalk",
       "mountainwalk" 	=> "Mountainwalk",
       "plainswalk" 	=> "Plainswalk",
       "swampwalk" 	=> "Swampwalk",

       "hackable" 	=> "Hackable",
       "sleightable" 	=> "Sleightable",

       "nontapping"	=> "No tap on attack",
       "pumps"		=> "Pumps without tapping",
       "tappable"	=> "Taps for effect",
       "hard2block"     => "Hard to block",
       "foggy"		=> "Foglike",
       "poisonous"	=> "Poisonous",
       "nohurt4effect"  => "No hurt for effect",
       "venomous"	=> "Basilisk-like",

   );
   # reduce namelist array to just odd elements; hash has both
   my $i = 0;
   @namelist = grep { ++$i & 1 } @namelist;

   if ($visible == SCREEN_DISPLAY) { 
	print qq{
	    This screen selects from a number of pre-defined special
	    abilities.	If you want to check for an ability not
	    listed here, you will have to compose it yourself using
	    the more expert-oriented @{[blue(poker("Type"))]}
	    or @{[yellow(poker("Wizard"))]} screens.
      };
}

    meta_select(  VISIBLE => $visible,
		  NAME    => $widname,
		  WIDGET  => fix_msie_lists(),
		  NAMES   => \@namelist,
		  LABELS  => \%labels,
    );

}

####################
# SCREEN: "Artist" #
####################
sub choose_artist {
    my $visible  = shift;
    my $widname  = "Artist";
    my @namelist;
    my %artist_mapping;

    # This is very sad, but the database has artists with strange
    # variant spellings.  So to get them, you need to fudge on a
    # regex search.
    #
    # left hand side of hash is code to pass to MoxPerl.
    # labels displayed are what is in rhs.
    # keep both to preserve ordering, which is lost in the hash.
    %artist_mapping = @namelist = (
	q{ARTIST() =~ m{Jeff Miracola}} =>"Jeff Miracola",
	q{ARTIST() =~ m{Rob\S* Alexander}} =>"Rob Alexander",
	q{ARTIST() =~ m{Eric David Anderson}} =>"Eric David Anderson",
	q{ARTIST() =~ m{Randy Asplund-Faith}} =>"Randy Asplund-Faith",
	q{ARTIST() =~ m{Janet Aulisio}} =>"Janet Aulisio",
	q{ARTIST() =~ m{John Avon}} =>"John Avon",
	q{ARTIST() =~ m{Daren Bader}} =>"Daren Bader",
	q{ARTIST() =~ m{Julie Baroh}} =>"Julie Baroh",
	q{ARTIST() =~ m{Thomas M. Baxa}} =>"Thomas M. Baxa",
	q{ARTIST() =~ m{Stuart Beel}} =>"Stuart Beel",
	q{ARTIST() =~ m{Jason Alexander Behnke}} =>"Jason Alexander Behnke",
	q{ARTIST() =~ m{Melissa Benson}} =>"Melissa Benson",
	q{ARTIST() =~ m{Kristen Bishop}} =>"Kristen Bishop",
	q{ARTIST() =~ m{Joel Biske}} =>"Joel Biske",
	q{ARTIST() =~ m{Robert Bliss}} =>"Robert Bliss",
	q{ARTIST() =~ m{John Bolton}} =>"John Bolton",
	q{ARTIST() =~ m{Kev Brockschmidt}} =>"Kev Brockschmidt",
	q{ARTIST() =~ m{Brom}} =>"Brom",
	q{ARTIST() =~ m{Sue Ellen Brown}} =>"Sue Ellen Brown",
	q{ARTIST() =~ m{Cornelius Brudi}} =>"Cornelius Brudi",
	q{ARTIST() =~ m{Catherine Buck}} =>"Catherine Buck",
	q{ARTIST() =~ m{Susan Van Camp}} =>"Susan Van Camp",
	q{ARTIST() =~ m{Doug Chaffee}} =>"Doug Chaffee",
	q{ARTIST() =~ m{David A. Cherry}} =>"David A. Cherry",
	q{ARTIST() =~ m{Chippy}} =>"Chippy",
	q{ARTIST() =~ m{Ron Chironna}} =>"Ron Chironna",
	q{ARTIST() =~ m{John Coulthart}} =>"John Coulthart",
	q{ARTIST() =~ m{Carl Critchlow}} =>"Carl Critchlow",
	q{ARTIST() =~ m{Liz Danforth}} =>"Liz Danforth",
	q{ARTIST() =~ m{Stephen Daniele}} =>"Stephen Daniele",
	q{ARTIST() =~ m{Michael Danza}} =>"Michael Danza",
	q{ARTIST() =~ m{G\S* Darrow}} =>"Geof Darrow",
	q{ARTIST() =~ m{Al Davidson}} =>"Al Davidson",
	q{ARTIST() =~ m{Den.*? Detwiler}} =>"Dennis Detwiller",
	q{ARTIST() =~ m{DiTerlizzi}} =>"DiTerlizzi",
	q{ARTIST() =~ m{Tony Diterlizzi}} =>"Tony Diterlizzi",
	q{ARTIST() =~ m{Dom!}} =>"Dom!",
	q{ARTIST() =~ m{William Donohoe}} =>"William Donohoe",
	q{ARTIST() =~ m{Mike Dringenberg}} =>"Mike Dringenberg",
	q{ARTIST() =~ m{Brian Durfee}} =>"Brian Durfee",
	q{ARTIST() =~ m{James Earnest}} =>"James Earnest",
	q{ARTIST() =~ m{Bob Eggleton}} =>"Bob Eggleton",
	q{ARTIST() =~ m{Randy Elliott}} =>"Randy Elliott",
	q{ARTIST() =~ m{Rick Emond}} =>"Rick Emond",
	q{ARTIST() =~ m{Sandra Everingham}} =>"Sandra Everingham",
	q{ARTIST() =~ m{Richard Kane Ferguson}} =>"Richard Kane Ferguson",
	q{ARTIST() =~ m{Cecil Fernando}} =>"Cecil Fernando",
	q{ARTIST() =~ m{Scott.*?Fischer}} =>"Scott Fischer",
	q{ARTIST() =~ m{Kaja Foglio}} =>"Kaja Foglio",
	q{ARTIST() =~ m{Phil Foglio}} =>"Phil Foglio",
	q{ARTIST() =~ m{Carl Frank}} =>"Carl Frank",
	q{ARTIST() =~ m{Dan Frazier}} =>"Dan Frazier",
	q{ARTIST() =~ m{Una Fricker}} =>"Una Fricker",
	q{ARTIST() =~ m{J. W. Frost}} =>"J. W. Frost",
	q{ARTIST() =~ m{Randy Gallegos}} =>"Randy Gallegos",
	q{ARTIST() =~ m{Dan Gelon}} =>"Dan Gelon",
	q{ARTIST() =~ m{Daniel Gelon}} =>"Daniel Gelon",
	q{ARTIST() =~ m{Donato Giancola}} =>"Donato Giancola",
	q{ARTIST() =~ m{Gary Gianni}} =>"Gary Gianni",
	q{ARTIST() =~ m{Th?om\S* Gianni}} =>"Thomas Gianni",
	q{ARTIST() =~ m{Charles Gillespie}} =>"Charles Gillespie",
	q{ARTIST() =~ m{Gerry Grace}} =>"Gerry Grace",
	q{ARTIST() =~ m{D\. Alexander Gregory}} =>"D. Alexander Gregory",
	q{ARTIST() =~ m{Stuart Griffin}} =>"Stuart Griffin",
	q{ARTIST() =~ m{Rebecca Guay}} =>"Rebecca Guay",
	q{ARTIST() =~ m{Justin Hampton}} =>"Justin Hampton",
	q{ARTIST() =~ m{Scott Hampton}} =>"Scott Hampton",
	q{ARTIST() =~ m{Mark Harrison}} =>"Mark Harrison",
	q{ARTIST() =~ m{Nathalie Hertz}} =>"Nathalie Hertz",
	q{ARTIST() =~ m{Carol Heyer}} =>"Carol Heyer",
	q{ARTIST() =~ m{David Ho}} =>"David Ho",
	q{ARTIST() =~ m{Craig Hooper}} =>"Craig Hooper",
	q{ARTIST() =~ m{Quinton Hoover}} =>"Quinton Hoover",
	q{ARTIST() =~ m{Brian Horton}} =>"Brian Horton",
	q{ARTIST() =~ m{Heather Hudson}} =>"Heather Hudson",
	q{ARTIST() =~ m{JOCK}} =>"JOCK",
	q{ARTIST() =~ m{Kari Johnson}} =>"Kari Johnson",
	q{ARTIST() =~ m{Janine Johnston}} =>"Janine Johnston",
	q{ARTIST() =~ m{Fay Jones}} =>"Fay Jones",
	q{ARTIST() =~ m{Edward Beard}} =>"Edward Beard, Jr.",
	q{ARTIST() =~ m{Ken Meyer}} =>"Ken Meyer, Jr.",
	q{ARTIST() =~ m{Kerstin Kaman}} =>"Kerstin Kaman",
	q{ARTIST() =~ m{Richard Kane-Ferguson}} =>"Richard Kane-Ferguson",
	q{ARTIST() =~ m{Mike Kerr}} =>"Mike Kerr",
	q{ARTIST() =~ m{Mike Kimble}} =>"Mike Kimble",
	q{ARTIST() =~ m{Hannibal King}} =>"Hannibal King",
	q{ARTIST() =~ m{Scott Kirschner}} =>"Scott Kirschner",
	q{ARTIST() =~ m{Patrick Kochakji}} =>"Patrick Kochakji",
	q{ARTIST() =~ m{Romas Kukalis}} =>"Romas Kukalis",
	q{ARTIST() =~ m{Tom Kyffin}} =>"Tom Kyffin",
	q{ARTIST() =~ m{Clint Langley}} =>"Clint Langley",
	q{ARTIST() =~ m{Jeff Laubenstein}} =>"Jeff Laubenstein",
	q{ARTIST() =~ m{Jennifer Law}} =>"Jennifer Law",
	q{ARTIST() =~ m{Gary Leach}} =>"Gary Leach",
	q{ARTIST() =~ m{April Lee}} =>"April Lee",
	q{ARTIST() =~ m{Paul Lee}} =>"Paul Lee",
	q{ARTIST() =~ m{Nicola Leonard}} =>"Nicola Leonard",
	q{ARTIST() =~ m{Steve Luke}} =>"Steve Luke",
	q{ARTIST() =~ m{Colin MacNeil}} =>"Colin MacNeil",
	q{ARTIST() =~ m{Anson Maddocks}} =>"Anson Maddocks",
	q{ARTIST() =~ m{John Malloy}} =>"John Malloy",
	q{ARTIST() =~ m{Dylan Martens}} =>"Dylan Martens",
	q{ARTIST() =~ m{John Matson}} =>"John Matson",
	q{ARTIST() =~ m{Val Mayerik}} =>"Val Mayerik",
	q{ARTIST() =~ m{Martin McKenna}} =>"Martin McKenna",
	q{ARTIST() =~ m{Harold McNeill}} =>"Harold McNeill",
	q{ARTIST() =~ m{Jeff.*?Menges}} =>"Jeff A. Menges",
	q{ARTIST() =~ m{Ian Miller}} =>"Ian Miller",
	q{ARTIST() =~ m{Jeff Miracola}} =>"Jeff Miracola",
	q{ARTIST() =~ m{Pat Morrissey}} =>"Pat Morrissey",
	q{ARTIST() =~ m{Jon J Muth}} =>"Jon J Muth",
	q{ARTIST() =~ m{Jesper Myrfors}} =>"Jesper Myrfors",
	q{ARTIST() =~ m{Ted Naifeh}} =>"Ted Naifeh",
	q{ARTIST() =~ m{Colin Mc *Neil}} =>"Colin Mc Neil",
	q{ARTIST() =~ m{Jim Nelson}} =>"Jim Nelson",
	q{ARTIST() =~ m{Cliff Nielsen}} =>"Cliff Nielsen",
	q{ARTIST() =~ m{Terese Nielsen}} =>"Terese Nielsen",
	q{ARTIST() =~ m{David O'Connor}} =>"David O'Connor",
	q{ARTIST() =~ m{William O'Connor}} =>"William O'Connor",
	q{ARTIST() =~ m{Margaret Organ-Kean}} =>"Margaret Organ-Kean",
	q{ARTIST() =~ m{Paolo Parente}} =>"Paolo Parente",
	q{ARTIST() =~ m{Keith Parkinson}} =>"Keith Parkinson",
	q{ARTIST() =~ m{Omaha Perez}} =>"Omaha Perez",
	q{ARTIST() =~ m{Eric Peterson}} =>"Eric Peterson",
	q{ARTIST() =~ m{Zak Plucinski}} =>"Zak Plucinski",
	q{ARTIST() =~ m{Alan Pollack}} =>"Alan Pollack",
	q{ARTIST() =~ m{Mark Poole}} =>"Mark Poole",
	q{ARTIST() =~ m{Dermot Power}} =>"Dermot Power",
	q{ARTIST() =~ m{George Pratt}} =>"George Pratt",
	q{ARTIST() =~ m{Mike Raabe}} =>"Mike Raabe",
	q{ARTIST() =~ m{Rabarot}} =>"Rabarot",
	q{ARTIST() =~ m{Alan Rabinowitz}} =>"Alan Rabinowitz",
	q{ARTIST() =~ m{Kathryn Rathke}} =>"Kathryn Rathke",
	q{ARTIST() =~ m{Roger Raupp}} =>"Roger Raupp",
	q{ARTIST() =~ m{Jeff Reitz}} =>"Jeff Reitz",
	q{ARTIST() =~ m{Adam Rex}} =>"Adam Rex",
	q{ARTIST() =~ m{Blackie del Rio}} =>"Blackie del Rio",
	q{ARTIST() =~ m{Tony Roberts}} =>"Tony Roberts",
	q{ARTIST() =~ m{Andrew Robinson}} =>"Andrew Robinson",
	q{ARTIST() =~ m{Christopher Rush}} =>"Christopher Rush",
	q{ARTIST() =~ m{Andi Rusu}} =>"Andi Rusu",
	q{ARTIST() =~ m{Zina Saunders}} =>"Zina Saunders",
	q{ARTIST() =~ m{Dav\S+ Seeley}} =>"Dave Seeley",
	q{ARTIST() =~ m{Doug\S* Sc?huler}} =>"Doug Shuler",
	q{ARTIST() =~ m{Bill Sienkiewicz}} =>"Bill Sienkiewicz",
	q{ARTIST() =~ m{Greg Simanson}} =>"Greg Simanson",
	q{ARTIST() =~ m{Adrian Smith}} =>"Adrian Smith",
	q{ARTIST() =~ m{Lawrence Snelly}} =>"Lawrence Snelly",
	q{ARTIST() =~ m{Brian Snoddy}} =>"Brian Snoddy",
	q{ARTIST() =~ m{Greg Spalenka}} =>"Greg Spalenka",
	q{ARTIST() =~ m{Ron Spencer}} =>"Ron Spencer",
	q{ARTIST() =~ m{Darbury Stenderu}} =>"Darbury Stenderu",
	q{ARTIST() =~ m{Steve *White}} =>"Steve White",
	q{ARTIST() =~ m{Michael Sutfin}} =>"Michael Sutfin",
	q{ARTIST() =~ m{Bryan Talbot}} =>"Bryan Talbot",
	q{ARTIST() =~ m{Mark Tedin}} =>"Mark Tedin",
	q{ARTIST() =~ m{NeNe Thomas}} =>"NeNe Thomas",
	q{ARTIST() =~ m{Richard Thomas}} =>"Richard Thomas",
	q{ARTIST() =~ m{Ruth Thompson}} =>"Ruth Thompson",
	q{ARTIST() =~ m{Jerry Tiritilli}} =>"Jerry Tiritilli",
	q{ARTIST() =~ m{Junior Tomlin}} =>"Junior Tomlin",
	q{ARTIST() =~ m{Drew Tucker}} =>"Drew Tucker",
	q{ARTIST() =~ m{Pete Venters}} =>"Pete Venters",
	q{ARTIST() =~ m{Diana Vick}} =>"Diana Vick",
	q{ARTIST() =~ m{Rogerio Vilela}} =>"Rogerio Vilela",
	q{ARTIST() =~ m{Franz Vohwinkel}} =>"Franz Vohwinkel",
	q{ARTIST() =~ m{Tom W\S*nerstrand}} =>"Tom Waenerstrand",
	q{ARTIST() =~ m{B[yr]+on Wackwitz}} =>"Byron Wackwitz",
	q{ARTIST() =~ m{Kev\S* Walker}} =>"Kev Walker",
	q{ARTIST() =~ m{Stephen L. Walsh}} =>"Stephen L. Walsh",
	q{ARTIST() =~ m{Anthony.*?Waters}} =>"Anthony S. Waters",
	q{ARTIST() =~ m{Amy Weber}} =>"Amy Weber",
	q{ARTIST() =~ m{Kipling West}} =>"Kipling West",
	q{ARTIST() =~ m{Michael Whelan}} =>"Michael Whelan",
	q{ARTIST() =~ m{Stev\S* White}} =>"Steve White",
	q{ARTIST() =~ m{White}} =>"White",
	q{ARTIST() =~ m{L\. *A. *Williams}} =>"L. A. Williams",
	q{ARTIST() =~ m{Dameon Willich}} =>"Dameon Willich",
	q{ARTIST() =~ m{Matthew Wilson}} =>"Matthew Wilson",
    );

   # reduce namelist array to just odd elements; hash has both
   my $i = 0;
   @namelist = grep { ++$i & 1 } @namelist;

    print <<EO_ART_INFO if $visible == SCREEN_DISPLAY;
<P>This will find cards by the artists named, even if
they are shared.<P>
EO_ART_INFO

    meta_select(  VISIBLE => $visible,
		  NAME    => $widname,
		  WIDGET  => fix_msie_lists(),
		  NAMES   => \@namelist,
		  LABELS  => \%artist_mapping,
    );

}

###################
# SCREEN: "Class" #
###################
sub choose_class {
    my $visible  = shift;
    my $widname  = "Class";
    my (@namelist, %labels);

    # left hand side of hash is code to pass to MoxPerl.
    # labels displayed are what is in rhs.
    # keep both to preserve ordering, which is lost in the hash.
    %labels = @namelist = (
	"creatures" 	    => "Creatures",
	"artifacts" 	    => "Artifacts",
	"sorceries" 	    => "Sorceries",
	"instants" 	    => "Instants",
	"interrupts" 	    => "Interrupts",
	"enchantments" 	    => "Any Enchantment",
	q{TYPE() eq 'Enchant World'} => "Enchant World",
	q{TYPE() eq 'Enchant Creature'} => "Enchant Creature",
	q{TYPE() eq 'Enchant Land'} => => "Enchant Land",
	"legendary"	    => "Legendary",
	"lands" 	    => "Lands",
	"summons" 	    => "Summons",
	"basic_lands" 	    => "Basic Lands",
	"special_lands"	    => "Special Lands",
	"walls" 	    => "Walls",
	"permanents" 	    => "Permanents",
	"buyback" 	    => "Buyback",
	"legend" 	    => "Legends",
	"cantrip" 	    => "Cantrip",
    );

   # reduce namelist array to just odd elements; hash has both
   my $i = 0;
   @namelist = grep { ++$i & 1 } @namelist;

    print <<"END_of_Class_Info" if $visible == SCREEN_DISPLAY;
	<P>If you just want all of one particular class of card,
	please see the <a href="/deckmaster/cards/Canned.html">Canned
	Listings</a> for pre-made lists, including far more than you
	can generate from here.  If you want to enter your own string,
	try either of the more expert-oriented @{[blue(poker("Type"))]}
	or @{[blue(poker("Text"))]} screens.  <P>
END_of_Class_Info

    meta_select(  VISIBLE => $visible,
		  NAME    => $widname,
		  WIDGET  => fix_msie_lists(),
		  NAMES   => \@namelist,
		  LABELS  => \%labels,
    );

}

#####################
# SCREEN: "Release" #
#####################
sub choose_release {
    my $visible  = shift;
    my $widname  = "Release";
    my %labels;
    my @namelist;

    # left hand side of hash is code to pass to MoxPerl.
    # labels displayed are what is in rhs.
    # keep both to preserve ordering, which is lost in the hash.
    %labels = @namelist =  (

	"EX" => "Exodus",
	"ST" => "Stronghold",
	"WE" => "Weatherlight",
	"TE" => "Tempest",
	"VI" => "Visions",
	"MI" => "Mirage",
	"AL" => "Alliances",
	"HL" => "Homelands",
	"IA" => "Ice Age",

	"FE" => "Fallen Empires",
	"DK" => "The Dark",
	"LG" => "Legends",
	"AQ" => "Antiquities",
	"AN" => "Arabian Nights",

	"beta" => "1st Edition (Limited)",
	"ULonly" => "2nd Edition (Unlimited)",
	"E3" => "3rd Edition (Revised)",
	"E4" => "4th Edition",
	"E5" => "5th Edition",

	"alpha"  => "Alpha",
	"beta()"  => "Beta",

	"CH" => "Chronicles",
	"PR" => "Promotionals",
    );

    # reduce namelist array to just odd elements; hash has both
    my $i = 0;
    @namelist = grep { ++$i & 1 } @namelist;

    print <<"EO_REL_INFO" if $visible == SCREEN_DISPLAY;
	<P>If you just want all of one particular release,
	see the <a href="/deckmaster/cards/Canned.html">Canned
	Listings</a> for faster, pre-generated lists.  For example,
	I have most everything you could think of about <a
	href="/deckmaster/cards/TE.html">Tempest</a> and <a
	href="/deckmaster/cards/ST.html">Stronghold</a> already done.
	If you're looking for tournament-legal cards, use the
	@{[blue(poker("Restriction"))]} screen, which now
	includes Stronghold and a pre-generated Type II listing.
EO_REL_INFO

    my @retval =
    meta_select(  VISIBLE => $visible,
		  NAME    => $widname,
		  WIDGET  => fix_msie_lists(),
		  NAMES   => \@namelist,
		  LABELS  => \%labels,
    );

    print <<'EO_REL_INFO' if $visible == SCREEN_DISPLAY;
<P>
If, for example, you include <a href="/deckmaster/cards/RV.html">Third
Edition</a> but exclude <a href="/deckmaster/cards/AN.html">Arabian
Nights</a>, you won't see any Kird Apes in your output.

<blockquote>
    <B>HOWEVER</B>: asking for the overlap or non-overlap between Mirage
    ad Ice Age and
    the Gathering does not yet work: the <a
    href="/deckmaster/cards/icy_manipulator_(ia).html">Ice Age version
    <b><i>Icy Manipulator</i></b></a> is retrieved as a totally separate
    card because it has a difference in something other than just release:
    artist and flavor.  
</blockquote>
EO_REL_INFO

    return @retval;

}

######################################################
# Manage all selection screens
######################################################
sub meta_select {
    my %parm = @_;

    my $widname  = $parm{NAME};
    my $visible  = $parm{VISIBLE};
    my $widfunc  = $parm{WIDGET};
    my @namelist = @{ $parm{NAMES} };
    my $labref   = $parm{LABELS};

    my $in   = "$widname included";
    my $out  = "$widname excluded";

    my $in_joiner  = "$in Conjunction";
    my $out_joiner = "$out Conjunction";

    my @ins  = get_param($in);
    my @outs = get_param($out);

    panic "$widname called voidly!" if $visible == SCREEN_CODEGEN && !defined wantarray;

    {
	my (%seen, @bogus);
	@seen{@outs} = ();
	@bogus = grep { exists $seen{$_} } @ins;
	if (@bogus) {
	    my $str = "(" . commify_series(@bogus) . ")";
	    oops "$str and not $str are mutually exclusive.  
		<B>All</B> $widname selections have been cleared!";
	    Delete($in);
	    Delete($in_joiner);
	    Delete($out);
	    Delete($out_joiner);
	}
    }

    if (@ins == @namelist) { # idiot chose them all
	oops("I told you that including everything for $widname was wrong.
	    <B>All</B> $widname selections have been cleared!  <P>What are
	    you really trying to do, anyway!?  You can't just casually
	    dump out every card in existence, you know!  My modem can't
	    handle several-hundred-kilobyte transfers at the drop of
	    a hat.  I'm afraid you're a bit confused about something.
	    Send me mail if you'd like clarification on something.
	");
	Delete($in);
	Delete($in_joiner);
    }

    if (@outs == @namelist) { # idiot chose them all
	oops("I told you that excluding everything for $widname was wrong");
	Delete($out);
	Delete($out_joiner);
    }

    if ($visible == SCREEN_HIDDEN) {
	if (@ins) {
	    print hidden(-NAME => $in);
	    print hidden(-NAME => $in_joiner) if get_param($in_joiner);
	}
	if (@outs) {
	    print hidden(-NAME => $out);
	    print hidden(-NAME => $out_joiner) if get_param($out_joiner);
	}
    }
    elsif ($visible == SCREEN_DISPLAY) {
	my $plural = plural($widname);
	print h2("$plural to include");

	broken_browser();

	if (isn't_programmer() && $widfunc == \&scrolling_list)   {
	    print p("<B>WARNING</B>: On some browsers, you may have to
		    hold down your <tt>SHIFT</tt> or <tt>CONTROL</tt>
		    key when making multiple selections.  YMMV.");
	}

	print p("Please don't select every one of these.  It won't help
		 winnow your search.");

	print "<DL>";

	print dt("Limit selection to cards that have", 
		popup_menu(-NAME    => $in_joiner,
			   -VALUES  => [ "any", "all" ],
			   -DEFAULT => [ "any" ],
			   ), "of these \l$plural.");

	my @args = (
	    -NAME     => $in,
	    -VALUES   => [ @namelist ],
	    -MULTIPLE => 1,
	    -COLS     => $parm{COLS} || 5,	# for buttons in checkbox_group
	    -SIZE     => $parm{SIZE} || 5,	# for lines in scrolling_list
	);
	push (@args, -LABELS => $labref) if $labref;
	print dd($widfunc->(@args));

	print "</DL>";

	print "<HR WIDTH='90%'>", h2("$plural to exclude");

	print("This is an <B>advanced menu</B> only, one which probably
		should not be used half so often as it is.  You might try your
		query first without any exclusions, and only if you
		get too many answers, come back to refine it by
		excluding some attributes.  If you end up excluding many
		of these, you may be going about this the hard way.");

	print "<DL>";

	print dt("Limit selection to cards that <B>do not</B> have", 
		popup_menu(-NAME    => $out_joiner,
			   -VALUES  => [ "any", "all" ],
			   -DEFAULT => [ "any" ],
			   ), "of these \l$plural.");

	@args = (
	    -NAME     => $out,
	    -VALUES   => [ @namelist ],
	    -MULTIPLE => 1,
	    -COLS     => $parm{COLS} || 5,	# for buttons in checkbox_group
	    -SIZE     => $parm{SIZE} || 5,	# for lines in scrolling_list
	);
	push (@args, -LABELS => $labref) if $labref;
	print dd($widfunc->(@args));

	print "</DL>";

    } elsif ($visible == SCREEN_CODEGEN) {
	my ($str_in, $str_out) = ('', '');


	if (get_param($in)) {
	    my $sep = (get_param($in_joiner) =~ /^any/) ? "or" : "and";
	    $str_in = "(" . join(" $sep ", get_param($in)) . ")";
	}

	if (get_param($out)) {
	    my $sep = (get_param($out_joiner) =~ /^any/) ? "or" : "and";
	    $str_out = "not (" . join(" $sep ", get_param($out)) . ")";
	}

	if ($str_in && $str_out) {
	    return "($str_in and $str_out)";
	} else {
	    return $str_in || $str_out;
	}

    } else {
	panic("unknown value for visible: $visible");
    }

}

##################
# SCREEN: "Card" #
##################
sub choose_card {
    my $visible = shift;
    print <<"EOF" if  $visible == SCREEN_DISPLAY;

	<P>If you just want to look up a card by name, you should be using
	the <A HREF="/deckmaster/cards/index.html">Fuzzy Matcher</A>,
	which tolerates spelling mistakes.  This one does not.	That one
	also runs about <B>1,000</B> times faster than this one.  <P> This
	screen searches <i>everywhere</I> on the card.	That means that
	the card's name, its type, regular text, flavor text, and artist
	are <i>all</i> searched.  Consequently, this query is a a good
	bit slower query than the @{[blue(poker("Text"))]} screen.  <P>

EOF
    meta_match(NAME => "Card", VISIBLE => $visible);
}

##################
# SCREEN: "Text" #
##################
sub choose_text {
    my $visible = shift;
    if ($visible == SCREEN_DISPLAY) {
	print qq{<P>This selects from only the card's regular text.
		 It does not look at incidental flavor text, the card
		 name itself, nor in its card type line.  I'm going to 
		 say it again for the logic-impaired: <B>This does not count the 
		 name of the card.</B> Those are on
		 different screens.<P>
	 };
    }
    meta_match(NAME => "Text", VISIBLE => $visible);
}

####################
# SCREEN: "Flavor" #
####################
sub choose_flavor {
    my $visible = shift;
    if ($visible == SCREEN_DISPLAY) {
	print "<P>This selects from the inspirational flavor text.  It
	does not affect game play.<P>I do not have flavor for TE or WL yet.<P>";
    }
    meta_match(NAME => "Flavor", VISIBLE => $visible);
}

##################
# SCREEN: "Name" #
##################
sub choose_name {
    my $visible = shift;
    if ($visible == SCREEN_DISPLAY) {
	print <<'EO_NAME_INFO';
<P>Enter here any specific <i>card name</i> to search for.  for
example, you might ask for <i>urza</i> to match all the cards with
``Urza'' in their name.
<P>If you just want to look up a card by its name without
any other selection criteria,
you really want 
to use the <A HREF="/deckmaster/cards/index.html">Fuzzy Matcher</A> 
instead.  It tolerates spelling mistakes and hazards guesses
for near misses (and even far ones!).  This one does not.  That one
also runs about <B>1,000</B> times faster.  Using this screen
for something the fuzzy matcher should be doing will incur a redirect.
You may override this by selecting a regular expression match (privileged
users only).
<P>
EO_NAME_INFO
    }
    meta_match(NAME => "Name", VISIBLE => $visible);
}

##################
# SCREEN: "Type" #
##################
sub choose_type {
    my $visible = shift;
    if ($visible == SCREEN_DISPLAY) {
	print  qq{
		<P>This selects from the type field just below the
		picture on the left, such as `Enchant World' or
		`Summon Berserker'.  You cannot use this screen to
		find all `creatures', for example, since that is not
		in the type line.  In fact, unless you're very clever,
		you won't even be able to find all `enchantments'.
		For these and many other interesting possibilities,
		use the @{[blue(poker("Class"))]} screen instead of
		this one.  <P>
	};
    }
    return meta_match(NAME => "Type", VISIBLE => $visible);
}

#####################
# SCREEN: "Rulings" #
#####################
sub choose_ruling {
    my $visible = shift;
    if ($visible == SCREEN_DISPLAY) {
	print qq{
    <P>This screen selects cards from Stephen D'angelo's
    <A HREF="/deckmaster/rules/general/">per-card
    rulings</A>.  It's much slower than running <A
    HREF="/deckmaster/forms/angelgrep.html">angelgrep</A>, but allows
    for more interesting questions.  See the nifty examples hanging off the
    Wizard screen accessible below.<P>
	};
    }
    return meta_match(NAME => "Ruling", VISIBLE => $visible);
}


######################################################
# Manage all match screens
######################################################
sub meta_match {
    my %parm = @_;

    my $widname  = $parm{NAME};
    my $visible  = $parm{VISIBLE};

    my $MBOOL   = "matchbool $widname";
    my $MTEXT   = "matchtext $widname";
    my $MHOW    = "matchhow $widname";
    my $MCASE   = "matchcase $widname";
    my $MANDOR  = "matchconj $widname";

    panic "$widname called voidly!" if $visible == SCREEN_CODEGEN && !defined wantarray;

    my @where_list = ( 'substring', 'whole word' );
    push (@where_list, 'complete entry') unless $widname =~ /card|ruling/i;
    push (@where_list, 'regular expression (Perl)', 'fuzzy match (SLOW!)')  if is_privileged();

    if ($visible == SCREEN_DISPLAY) {

	print dt("Select only those cards whose",
	em(lc($widname) . ($widname !~ /text/i && " text")), "fields<P>"),

	    dd(popup_menu(
		-NAME => "$MBOOL 1",
		-VALUES => [ 'contain', "don't contain" ],
		-DEFAULT => 'contain'),
	    textfield(
		-NAME => "$MTEXT 1",
		-SIZE => 30,
	    )), dd( "as a",
	    popup_menu(
		-NAME => "$MHOW 1",
		-VALUES => \@where_list,
		-DEFAULT => 'substring'),
		"case",
	    popup_menu(
		-NAME => "$MCASE 1",
		-VALUES => [ "insensitively", "SENSITIVELY" ],
		-DEFAULT => "insensitively")
	);

	print "<P>";
	print dt( popup_menu(
	    -NAME    => $MANDOR,
	    -VALUES  => [ "and also", "or else" ],
	    -DEFAULT => "or else",
	));
	print "<P>";

	print
	    dd(popup_menu(
		-NAME => "$MBOOL 2",
		-VALUES => [ 'contain', "don't contain" ],
		-DEFAULT => 'contain'),
	    textfield(
		-NAME => "$MTEXT 2",
		-SIZE => 30,
	    )), dd( "as a",
	    popup_menu(
		-NAME => "$MHOW 2",
		-VALUES => \@where_list,
		-DEFAULT => 'substring'),
		"case",
	    popup_menu(
		-NAME => "$MCASE 2",
		-VALUES => [ "insensitively", "SENSITIVELY" ],
		-DEFAULT => "insensitively")
	);
	print "</DL>";

    }
    elsif ($visible == SCREEN_HIDDEN) {

	if (get_param("$MTEXT 1") =~ /\S/) {
	    print(  hidden(-NAME => "$MBOOL 1"),
		    hidden(-NAME => "$MTEXT 1"),
		    hidden(-NAME => "$MHOW 1"),
		    hidden(-NAME => "$MCASE 1")  );
	}

	if (get_param("$MTEXT 1") =~ /\S/ && get_param("$MTEXT 2") =~ /\S/) {
	    print hidden($MANDOR);
	} 


	if ( get_param("$MTEXT 1") =~ /\S/	&&
	     get_param("$MTEXT 2") =~ /\S/	)
	{
	    print hidden( -NAME => "$widname conj");
	}

	if (get_param("$MTEXT 2") =~ /\S/) {
	    print(  hidden(-NAME => "$MBOOL 2"),
		    hidden(-NAME => "$MTEXT 2"),
		    hidden(-NAME => "$MHOW 2"),
		    hidden(-NAME => "$MCASE 2")  );
	}
    }
    elsif ($visible == SCREEN_CODEGEN) {
	my($str1, $str2) = ('', '');

	if (get_param("$MTEXT 1") =~ /\S/) {

	    my $accessor     = uc "$widname()";
	    my $yesno        = get_param("$MBOOL 1") !~ /don't/i;
	    my $style 	     = get_param("$MHOW 1");
	    my $match_text   = get_param("$MTEXT 1");
	    my $case_matters = get_param("$MCASE 1") =~ /^SENS/;

	    $str1 = build_match($accessor, $yesno, $style,
				    $match_text, $case_matters);
	}

	if (get_param("$MTEXT 2") =~ /\S/) {

	    my $accessor     = uc "$widname()";
	    my $yesno        = get_param("$MBOOL 2") !~ /don't/i;
	    my $style 	     = get_param("$MHOW 2");
	    my $match_text   = get_param("$MTEXT 2");
	    my $case_matters = get_param("$MCASE 2") =~ /^SENS/;

	    $str2 = build_match($accessor, $yesno, $style,
				    $match_text, $case_matters);
	}

	if ($str1 && $str2) {
	    return "(" . $str1 .
		    (get_param($MANDOR) =~ /and/ ? " and " : " or ")
		    . $str2 .  ")";
	} else {
	    return $str1 || $str2;
	}

    }

}

# Generate Perl code for the match screens
sub build_match {
    my ($accessor, $yesno, $style, $text, $case_matters) = @_;

    my $code =  '';

    for ($text) {
	s/^\s+//;
	s/\s+$//;
	if ($style =~ /regular/i) {
	    s{^/(.*)/$}{$1}s;    # trim slash delims
	    s{^\\(.*)\\$}{$1}s;  # trim backslash delims IDIOTS
	}
    }

    if ($style =~ /substring/i) {
	for ($text) {
	    s/([^\w\s])/\\$1/g;
	    s/\s+/ /g;
	    s/f$/(f|ves)/;
	    s/s$/s?/;
	}
	$code = $accessor . ' ' . ($yesno ? "=" : "!") . "~ m{$text}";
	$code .= 'i' unless $case_matters;
    } elsif ($style =~ /whole word/i) {
	for ($text) {
	    s/([^\w\s])/\\$1/g;
	    s/\s+/ /g;
	    s/f$/(f|ves)/;
	    s/s$/s?/;
	}
	$code = $accessor . ' ' . ($yesno ? "=" : "!") . "~ m{\\b$text\\b}";
	$code .= 'i' unless $case_matters;
    } elsif ($style =~ /complete/i) {
	$code = ($case_matters      ? $accessor : " lc($accessor) ")
	       . ($yesno ? " eq " : " ne ")
	       . ($case_matters ? " q{$text} " : "q{\L$text}\E " )
	    ;
    } elsif ($style =~ /regular/i) {
	$text =~ s/ +/\\s+/g;
	unless (eval { 'BOGOTIC' =~ m{$text}; 1 }) {
	    oops("Bad regular expression: ", em($text), ": ", tt($@));
	    return;
	}
	$code = $accessor .  ' ' . ($yesno ? "=" : "!") .  "~ m{$text}";
	$code .= 'i' unless $case_matters;
    } elsif ($style =~ /fuzzy/i) {
	$code = ($yesno ? "" : "!") 
	      . "amatch(q{$text}, "
	      .  (!$case_matters ? "['i'], " : "") 
	      .  "$accessor)";
    } else {
	panic("unknown style <$style>");
    }

    if ($accessor =~ /TYPE/i) {
	my $nosum = $text;
	$nosum =~ s/^summons?\s+(?=\S)//i;
	#$nosum =~ s/s$/s?/;
	my $a_or_an = $nosum =~ /^[aeiouh]/ ? 'an' : 'a';
	$code .= " or TEXT() "
  	      . ($yesno ? "=" : "!")
	      . "~ m{$nosum token|counts as $a_or_an $nosum}"
	      . ($case_matters ? "" : "i");
	$code = "($code)";
    }

    return $code;

}

####################
# SCREEN: "Wizard" #
####################
sub wizards_only {

    #########################################################
    # This gives direct access to the real MoxPerl engine.
    # If they don't know what that means, they lose.
    #########################################################

    my $visible = shift;
    my $WIZ = "wizard query";

    panic "$WIZ called voidly!" if $visible == SCREEN_CODEGEN && !defined wantarray;

    if ($visible == SCREEN_DISPLAY) {

	print h2(center(em("Lasciate ogni speranza, voi ch'entrate!")));

	unless (is_privileged) {
	    print "<P>You must first register your mail address to access this screen.";
	    print "Please @{[yellow(poker('Login'))]} first.";
	    return;
	} 

	# current disabled 
	if (0 and isn't_programmer()) {
	    print <<'EO_WINDUMB';
<HR> <H2 ALIGN="CENTER">Warning to <I>Prisoners of Bill</I></H2>

    This is <i>not</i> a help screen, you know!  You don't come here
    <I>in search of</I> a wizard.  You come here because you <i>are</i>
    a wizard; in particular, a Perl programming wizard.  It's for power
    users who want to venture beyond what the other screens' 
<A HREF="http://www.wins.uva.nl/~mes/jargon/p/point-and-droolinterface.html">point-and-drool</A>
    interfaces could otherwise provide.  

    <P>Since you don't appear to have installed an <A
    HREF="http://www.perl.com/cgi-bin/bados">operating
    system</a>, I'm afraid that <A
    HREF="http://www.wins.uva.nl/~mes/jarg320.old/y/Youarenotexpectedtounderstandthis.html">YANETUT</A>.

<HR>

EO_WINDUMB
	}

	print p("This screen lets you add arbitrary selection criteria
	    to talk to the real MoxPerl database directly.  There is no limit
	    to the awesome power now at your fingertips!");

	# make new filehandle, protect $_, restore $\ 
	local (*FH, $_, $\);
	if (open(FH, "/deckmaster/info/wizinfo.html")) {
	    while (<FH>) {
		next if /TITLE>/i;
		next if /H\d>/i;
		print;
	    } 
	    close FH;
	} 

	print hr(), p("This screen lets you add arbitrary selection criteria
	    to talk to the real MoxPerl database directly.");

	print p(center(textarea(
		-NAME => $WIZ,
		-ROWS => 8,
		-COLS => 60,
	)));

	if (is_privileged()) { # easter egg
	    print p("Override size restrictions on large queries? ",
		 checkbox( -NAME     => "please",
			   -LABEL    => "",
			   -VALUE    => 1,
			   -SELECTED => get_param("please"),
	       ));
	}

    }

    elsif ($visible == SCREEN_HIDDEN)  {
	print hidden($WIZ)     if get_param($WIZ) =~ /\S/;
	print hidden("please") if get_param("please") && is_privileged();
    }
    elsif ($visible == SCREEN_CODEGEN) {
	my $query = get_param($WIZ);
	$query =~ s/[\n\r]//g;
	if (is_privileged() && get_param("please")) {
	    my $magic_passphrase =
                join  _=> split /\s+/ => join
			~~~~~~~~~~
                chr 1<<2 ** 2<<1      => grep {
                    y/a-zA-Z/n-za-mN-ZA-M/
                } reverse qw{
                    cyrnfr    pneqf
                    gur   nyy   unir
                    gb   yvxr  ernyyl
                            V'q
                };
	    if ($query =~ /\S/) {
		return "($query) and $magic_passphrase";
	    } else {
		return $magic_passphrase;
	    }
	}
	if ($query =~ /\S/) {
	    return "($query)";
	} else {
	    return;
	}
    }
}

BEGIN {  # create static variable scope for enclosed function

##################################################################
# They pick a key, and the value is what gets passed into the
# MoxPerl database.  It knows how to compile the descriptions
# given into perl format/write combos to produce very cheap,
# fast, and convenient tabular output that looks better than 
# HTML tables.  Please don't ask me about the suicide cat.
##################################################################
my %_Format_Table = (
    'Checklist Format'      => 'name cost powtuf n_printrun type',
    'Names Only'            => 'NOTITLE name:*',
    'Color and Type'        => 'name v_color type@27',
    'Printrun and Color'    => 'name n_printrun@14 color',

    'Short Spoilers'    => q{
	 name n_printrun cost color.type.powtuf
	 NEWLINE FILL SPACE=2 text^60
    },

    'Long Spoilers' => q{
	 name SPACE n_printrun "<B>" cost "</B>" powtuf.type NEWLINE
	 "<BR>" text^25 SPACE:12 "<I>" flavor^40 "</I>" NEWLINE FILL
	 SPACE=1 text^25 SPACE:1 artist^|11 "<I>" SPACE:1 flavor^40
	 "</I>" NEWLINE "<HR>"
    },

    'Full Card' => q{
	 NOTITLE
	 "<H3>" name:30 "</H3><P></PRE>" \n
	 v_printrun:* \n "<BR>"
	 v_color.type.powtuf:* \n "<BR>" INHIBIT "Casting Cost: <CODE><B>"
	 cost:* \n "</CODE></B><BR>"
	 "<P>" text:* \n "<BR>"
	 "<P><BLOCKQUOTE><I>" flavor:* \n "<BR></i></BLOCKQUOTE><P>" \n
	 "<i>Illustrated by " artist   \n "</i><P>"
	 "<PRE><HR>"
    },

);

####################
# SCREEN: "Format" #
####################
sub get_format {
    my $visible = shift;

    my @format_names = (
	'Checklist Format',
	'Names Only',
	'Color and Type',
	'Printrun and Color',
	'Short Spoilers',
	'Long Spoilers',
	'Full Card',
    );

    if ($visible == SCREEN_DISPLAY) {

	# TODO: Give a wizard-only direct-input option for
	#       format as they have for the full query.

	print

	    "<P>Would you like column headers?",
	    popup_menu(-NAME    => "column headers",
		       -VALUES  => [ qw(Yes No) ],
		       -DEFAULT => "Yes"),
	    br(),

	    "Would you like output broken up by major sort sections?",
	    popup_menu(-NAME    => "sort headers",
		       -VALUES  => [ qw(Yes No) ],
		       -DEFAULT => "Yes"),
	    br(),

	    "Select a standard format:",
	    popup_menu(-NAME    => "canned format",
		       -VALUES  => \@format_names,
		       -DEFAULT => "Checklist Format"),
	    br(),
	; # end of print

	print <<EO_DESC;
<H3>Description of formats</H3>
<B>Checklist Format</B> means the normal, one-entry-per-line output containing fields
    name, cost, powtuf, printrun, and type.
<B>Names Only</B> means the obvious thing.
<B>Color and Type</B> means name plus color plus type.
<B>Printrun and Color</B> means name plus color plus printrun.
<B>Short Spoilers</B> means compact spoiler form.
<B>Long Spoilers</B> means longer spoiler form.
<B>Full Card</B> means complete card text in a pretty but space-wasting layout.

EO_DESC

	# I don't think I like this a({}) stuff.
	print p(
	    "For more information, please consult the ",
	    a({href => "/deckmaster/info/sample_formats.html" },  "examples"),
	    "of sample output given by each standard format."
	);

    }
    elsif ($visible == SCREEN_HIDDEN) {
	print hidden("column headers"),
	      hidden("sort headers"),
	      hidden("canned format");
    }
    elsif ($visible == SCREEN_CODEGEN) {
	my $str = '';
	$str .= " NOTITLE" 	 if get_param("column headers") =~ /no/i;
	$str .= " NOSORTHEADERS" if get_param("sort headers")   =~ /no/i;

	my $style  = get_param("canned format") || "Checklist Format";
	my $format = $_Format_Table{ $style };
	$str .= " $format";
	for ($str) {
	    #s/\n\s+/ /gm;
	    s/^\s+//gm;
	}
	return $str;
    }

}

} # End scope for function private data

#####################
# SCREEN: "Sorting" #
#####################
sub get_sorting {
    my $visible = shift;

    # TODO: Give a wizard-only direct-input option for
    #       sort as they have for the full query.

    my($S_HOW, $S_UP) = ("sort criterion", "sort gravity");

    #####################################################
    # These sort criteria are defined over inside of the 
    # MoxPerl Database Server, which does the most grotesque
    # things that I hope you'll never see to make multiple 
    # releases, costs, types, etc all work out.
    #####################################################
    my @sort_types = qw(
			    Color Release Rarity Name Type Metatype Cost
			    Power Toughness Powtuf Artist
		    );

    if ($visible == SCREEN_DISPLAY) {
	print <<'END_OF_SORTINFO';
<P>
Then select a way to sort.  Note that there are not always straight ASCII
or numeric sorts: ``color'' will generate things the ordering <i>land,
artifact, gold, white, green, red, blue, black</i> when sorted in an
ascending fashion, and the reverse when sorted in a descending way.
<P>
Likewise ``cost'' would place everything that costs say <B>3</B>
all together, but within that grouping would weight colored mana higher.  For example,
    <img src="/deckmaster/gifs/w.gif" alt="W" height=15 width=15>
    <img src="/deckmaster/gifs/w.gif" alt="W" height=15 width=15>
    <img src="/deckmaster/gifs/w.gif" alt="W" height=15 width=15>
would come first side-by-side with something like
    <img src="/deckmaster/gifs/w.gif" alt="W" height=15 width=15>
    <img src="/deckmaster/gifs/g.gif" alt="G" height=15 width=15>
    <img src="/deckmaster/gifs/u.gif" alt="U" height=15 width=15>,
followed by
<B>
<img src="/deckmaster/gifs/w.gif" alt="W" height=15 width=15>
<img src="/deckmaster/gifs/w.gif" alt="W" height=15 width=15>1</B>,
and then
<B>
<img src="/deckmaster/gifs/w.gif" alt="W" height=15 width=15>2</B>,
and finally <B>3</B>.
<P>
It makes no sense to sort first by <tt>type</tt> followed
by <tt>metatype</tt>, although sorting first by <tt>metatype</tt> 
and <i>then</i> by <tt>type</tt> is quite handy.
END_OF_SORTINFO

	print "<OL>";

	my ($msg, $defstyle) = ("Then", "Name");
	for (my $i = 1; $i <= $SORT_LEVELS; $i++) {

	    ($msg, $defstyle) = do {
		$i == 1 ? ("First", "Color" )  :
		$i == 2 ? ("Then",  "Rarity")  :
		          ("Then",  "Name"  )
	    };

	    print li("$msg sort by ",
		popup_menu(-NAME    => "$S_HOW $i",
			   -VALUES  => \@sort_types,
			   -DEFAULT => $defstyle),
		popup_menu(-NAME    => "$S_UP $i",
			   -VALUES  => [ "Ascending", "Descending" ],
			   -DEFAULT => "Ascending")
	    );


	}

	print qq(</OL>); 

	print "<P>Suppress duplicate cards?  <small><i>(e.g., from differing artists or releases)</i></small>",
	    popup_menu(-NAME    => "trim duplicates",
		       -VALUES  => [ qw(Yes No) ],
		       -DEFAULT => "Yes");

	print qq(<P> If you don't want per-category sort headers,
	    now go on to the @{[yellow(poker("Format"))]} screen.
	    <P> Programmers curious how this really
	    works might wish to consult the and the <A
	    HREF="/deckmaster/info/schema/sorting.txt">sorting
	    internals</A> document.);

    }
    elsif ($visible == SCREEN_HIDDEN) {
	for (my $i = 1; $i <= $SORT_LEVELS; $i++) {
	    print hidden("$S_HOW $i"), hidden("$S_UP $i");
	}
	print hidden("trim duplicates");
    }
    elsif ($visible == SCREEN_CODEGEN) {
	my $str = '';
	my %seen;

	for (my $i = 1; $i <= $SORT_LEVELS; $i++) {
	    my $how = lc get_param("$S_HOW $i");
	    $how = 'v_release' if $how eq 'release';
	    my $up  = get_param("$S_UP $i") =~ /descend/i ? '~' : '';
	    next if $seen{$how}++;
	    $str .= " " . $up . $how;
	}

	$str ||= 'color rarity name';  # DEFAULT SORT

	$str .= " SAVEDUPS " if get_param("trim duplicates") =~ /No/i;

	return trim($str);
    }

}

#####################
# SCREEN: "Execute" #
#####################
sub run_query {
    my $visible = shift;
    return unless $visible == SCREEN_DISPLAY;

    my $qstring = get_user_query();

    unless ($qstring) {
	oops("You have no query to execute!");
	return;
    }

    if (color_check() != 0) {
	print qq{<P>Sorry, your colors are unco&ouml;rdinated.  Please
	    fix them on the @{[blue(poker("Color"))]} screen.\n};
	return;
    } 

    local *SERVER;
    find_server();

    my $format           = $State_Table{"Format"} ->(SCREEN_CODEGEN);
    my $user_sort_string = $State_Table{"Sorting"}->(SCREEN_CODEGEN);

    my $login = get_param("login");

    local $\;  # turn off those extra newlines for server transmission

    print SERVER '$agent = ', hexaquote(user_agent()), ";\n";
    print SERVER '$origin = ',hexaquote($0), ";\n";
    print SERVER '$remote = ',hexaquote(remote_host()), ";\n";
    print SERVER '$query = ', hexaquote($qstring), ";\n";
    print SERVER '$sort = ',  hexaquote($user_sort_string), ";\n" if $user_sort_string;
    print SERVER '$login = ', hexaquote($login), ";\n" if $login;
    print SERVER '$format = ',hexaquote($format), ";\n" if $format;

    print SERVER "<<EOF>>\n";	# from before I grokked shutdown(2)

    while (<SERVER>) {
	next if /<TITLE>/i;
	if (/<H3>(\d+) matches /) {
	    warn("$Query{Session}: query matched $1 cards\n")
	}
	print;
    }
    close SERVER;
}

###################################################
# open the socket to the database server;
# delay loading of Socket.pm module until run time since
# this function is nearly never called.
###################################################
sub find_server {
    require Socket;
    Socket->import();
    socket(SERVER, &PF_UNIX, &SOCK_STREAM, 0)     || die "socket: $!";
    connect(SERVER, sockaddr_un($SERVER_PATH))  || die "connect: $!";
    select((select(SERVER),$|=1)[0]);
}

# This should not happen.  Blow chow seriously.
sub panic {
    print h1("Unexpected Error");
    print "<XMP>";
    print "@_\n";
    &confess;
}

# Chide the user for doing something bad.  Bad user! 
sub oops {
    my $msg = "@_";
    print dl(dt(red(strong("Fatal Error")), dd($msg)));
    $msg =~ s/\s+/ /g;
    substr($msg, 100) = '' if length($msg) > 100;
    warn "$Query{Session}: $msg\n";
}

# Given an English noun in the singular, guess its plural.
# This works due to very limited input range.  Not all 
# corpora will be correctly handled.
sub plural {
    local $_ = shift;

    if (/^(.*?)( of .*)$/) { return plural($1) . $2 }

    # order really matters here!
    s/(ss)$/${1}es/ 			    ||
    s/([psc]h)$/${1}es/			    ||
    s/(z)$/${1}es/			    ||
    s/ff$/ffs/			    	    ||
    s/f$/ves/			    	    ||
    s/ey$/eys/			    	    ||
    s/y$/ies/			    	    ||
    s/ix$/ices/			    	    ||
    s/([sx])$/$1es/			    ||
    s/$/s/		    		    ||
    die "can't get here";

    return $_;
}

#############################################################
# convert list into comma- and "and"-separated string
#############################################################
sub commify_series {
    (@_ == 0) ? '' 					:
    (@_ == 1) ? $_[0] 					:
    (@_ == 2) ? join(" and ", @_)  			:
	        join(", ", @_[0 .. ($#_-1)], "and $_[-1]");
}

# escape html
sub htesc {
    local $_ = "@_";
    s/&/&amp;/g;
    s/</&lt;/g;
    s/>/&gt;/g;
    s/"/&quot;/g;
    s/$/<BR>/gm;
    return $_;
}

#############################################################
# output the user's query so far
#############################################################
sub dump_query {
    my $query = get_pretty_query();

    unless ($query) {
	print "<P>You have no query to review 
	    because you haven't yet chosen anything.  Please
	    pick one of the buttons below and make some selections.";
	return;
    } 

    print dl(dt("Your query so far:",
	p(dd(dl(strong($query))))));

    my $canned_format = get_param("canned format");
    my $extra = join (" or ",
			grep { get_param($_) =~ /no/i }
			("column headers", "sort headers"));

    if ($canned_format) {
	print p("Your format style is:", strong($canned_format),
	    ($extra && "without $extra."));

	my $fmt_code = $State_Table{"Format"}->(SCREEN_CODEGEN);
	$DEBUG && print p("Format code is: ",
			blockquote(strong(htesc($fmt_code))));

    }

    my $sort_choices = $State_Table{"Sorting"}->(SCREEN_CODEGEN);
    if ($sort_choices) {
	print p("You are sorting this way: ",
		strong($sort_choices));
    }

    print "<P>If you like the way the query reads right now, feel free to 
    use the <B>Execute</B> button below.  Otherwise, go ahead and
    add or subtract some items from this query, and then come back to 
    this screen to confirm.";

}

#############################################################
# Produce perl-parsable version of current user query.
#############################################################
sub get_user_query {
    my $output = join " and " =>
		 grep { /\S/ }
		 map  { $State_Table{$_}->(SCREEN_CODEGEN) }
		 sort 
		 ('Wizard', grep { is_selection($_) }  keys %State_Table);
		# This hack cuz the Wizard screen isn't called choose_wizard
    $output =~ s/\((\w+)\)/$1/g;
    #$output =~ s/^\((.*)\)$/$1/gs;
    return $output;
}

#############################################################
# Produce html-escaped and formatted version of current user query.
#############################################################
sub get_pretty_query {
    my $output =  join dt("and") =>
		map  { dd(htesc($_)) }
		grep { /\S/ }
		map  { $State_Table{$_}->(SCREEN_CODEGEN) }
		 ('Wizard', grep { is_selection($_) }  keys %State_Table);
		# This hack cuz the Wizard screen isn't called choose_wizard
    $output =~ s/\((\w+)\)/$1/g;
    return $output;
}

#############################################################
# stupid encoding to send to database server who should
# really use something better.  i was not very clever in 
# my youth.
#############################################################
sub hexaquote {
    local $_ = shift;
    s/(\\|')/\\$1/g;
    s/([^\s\w])/sprintf('\\x%02X', ord $1)/ge;
    return qq('$_');
}

BEGIN {  # create private scope for enclosed function

    my %_Valid;  # function-private data

    ###################################################################
    # Traverse the program's symbol table *AT COMPILE TIME* for functions
    # called main::choose_*().  Any with this name get marked as a valid
    # choice-selection screen, and therefore go in the set of buttons at
    # the bottom of the user's screen.
    #
    # This must happen *after* compiler sees all choose_*() functions
    # which means that anything below this scope doesn't count.
    ###################################################################

    for (keys %main::) {
	no strict 'refs';   # for the defined test below
	if (/^choose_/ && defined(&$_) ) {
	    #
	    # Store reference as key, which stringifies and destroys it.
	    # Poor dead reference.  That's ok, since we don't need to call
	    # it indirectly, just check its string value.
	    #
	    # 	"Twisted cleverness is my only skill as a programmer."
	    #					--Elizabeth Zwicky
	    #
	    $_Valid{ \&$_ } = 1;
	}
    }

    # Does this state bring up a choose_() screen?
    sub is_selection {
	my $name = shift;
	my $action = $State_Table{$name};
	return unless $action;
	return $_Valid{$action};
    }

}


#############################################################
# remove leading and trailing white space.
# inputs of undef turn into a defined null
# to silence -w warnings.
#############################################################
sub trim {
    my @out = @_;
    for (@out) {
	s/^\s+//;
	s/\s+$//;
    }
    return @out if wantarray;
    return '' if @out == 0;
    return $out[0];
}

#############################################################
# make sure incoming form parameters are blank-trimmed and  #
# de-undeffed.                                              #
                                                            #
    sub get_param { trim(&param) }                          #
                                                            #
###################                                         #
# and just for orthogonality (not me!)                      #
# and legibility... (that either)                           #
##################                                          #
                                                            #
    sub set_param { &param }                                #
                                                            #
#                                                           #
#############################################################


#############################################################
# send the current state info etc to the tracefile
#############################################################
sub tracelog {

    set_internal_state();

    my $cur_query = shift;
    my $state_msg;
    my $age   = time - (get_param("__Start") || 0); # ||0 is for -w
    my $vers  =         get_param("__Version");
    my $count =         get_param("__Count");
    my $who   =         get_param("__ID");

    # Don't know that this is worth is
    $Query{Start}   = $age;
    $Query{Version} = $vers;
    $Query{Count}   = $vers;
    $Query{Session} = $who;
    $Query{Agent}   = user_agent();

    $state_msg  = sprintf "%s %d: %s", $who, $count, 
		    $Was_Mapclick ? "[$State]" : $State;
    $state_msg .= sprintf ", t=%s", relative_age($age) if $count;
    $state_msg .= sprintf ", q=%d", length($cur_query) if length($cur_query);
    $state_msg .= sprintf " from %s", $Query{Agent};

    warn "$state_msg\n";

    if ($State eq 'Execute') {
	$cur_query =~ s/\s+/ /g;
	warn "$who QUERY: $cur_query\n";
    }
}

#############################################################
# given seconds, convert to 4d9h23m15s format.
#############################################################
sub relative_age {
    my $secs = shift;
    my($days, $hours, $mins);

    $days  = int($secs / (24 * 60 * 60));
    $secs -= $days     * (24 * 60 * 60);

    $hours = int($secs / (60 * 60));
    $secs -= $hours    * (60 * 60);

    $mins  = int($secs / 60);
    $secs -= $mins     * 60;

    my $retstr  = '';
    $retstr .= $days  . "d" if $days;
    $retstr .= $hours . "h" if $hours;
    $retstr .= $mins  . "m" if $mins;
    $retstr .= $secs  . "s";

    return $retstr;

}

#############################################################
# set and/or get all our internal state and trace variables,
# which all begin with a double leading underbar.
#############################################################
sub set_internal_state {
    set_param("__Start", time()) 	     unless get_param("__Start");
    set_param("__Count", 0) 		     unless get_param("__Count");

    my $login = get_param("login");
    my $id    = get_param("__ID");

    # no ID at all yet
    if (!$id) {
	$id = remote_host() . " $$";
	$id =~ s/^/<$login> / if $login;
	set_param("__ID", $id);
    }
    # if they have a login, but their id still has only one space,
    # we'll prepend the new one because they've just now chosen a login
    elsif ($login && ($id =~ y/ / /) == 1) {
	set_param("__ID", "<$login> $id");
    }

    print hidden("__Start");
    print hidden("__ID");

    print hidden(
	    -NAME 	=> '__Count',
	    -VALUE 	=> 1 + get_param("__Count"),
	    -OVERRIDE 	=> 1,
    );

    print hidden(
	    -NAME 	=> '__Version',
	    -VALUE 	=> $CUR_VERSION,
	    -OVERRIDE 	=> 1,
    );
}


#######################################################
# The banner() function used below not only
# does a start_html, it also does a start_form,
# allowing hidden widget generation thereafter.
# Can't call this before checking for location redirect 
# to the Fuzzy Matcher.
#######################################################
sub banner {
    my $name = "MoxPerl v$CUR_VERSION: @_";

    print start_html(
	-TITLE   => $name,
	-AUTHOR  => 'tchrist@mox.perl.com',
	-META    => { 'keywords'   => 'perl magic mox',
		      'copyright'  => 'Copyright 1998 Tom Christiansen',
		    },
	-BGCOLOR => is_registered() ? "#F1F1F2" : "#C0C0C0",   
			    # light light blue     or icky grey
	-TEXT    => "#000000",
	-LINK    => "#3333FF",  # I am, of course, a Blue player.
	-VLINK   => "#551A8B",
	-ALINK   => "#CC0000",
    );

    print <<"EO_START";

<H1 ALIGN="CENTER">

<A HREF="http://www.wizards.com/">
<IMG ALIGN="center" SRC="/deckmaster/gifs/mtg.gif" width=160 height=120  Alt="Magic: The Gathering" vspace=5>
</a>

$name

EO_START

    print <<"EO_START" unless $State eq 'Execute';
<A HREF="http://www.perl.com/">
<IMG SRC="http://www.perl.com/graphics/perl_id_313c.gif" ALT="Programming
Republic of Perl" WIDTH="90" HEIGHT="90" ALIGN="center"></A>
EO_START

    print "</H1>";

    version_check();

    print start_form();
}

# Bottom of every page.
sub show_trailer {
    print <<'EO_ACKS';
<HR noshade>
<CENTER>
<H2>
<IMG ALIGN="top" SRC="/deckmaster/gifs/Linux_inside_small.gif" ALT="Linux Inside">
Acknowledgements
<IMG ALIGN="top" SRC="/deckmaster/gifs/vi.gif" ALT="Powered by vi">
</H2>
</center>

This database was prepared by Tom Christiansen, and includes copyrighted
material from <I><b>Magic: The Gathering</b></I><sup>TM</sup>, a product
of <I><b>Wizards of the Coast, Inc.</b></I> (WotC).  All card texts and
layouts, card names, and graphics included here are copyright © Wizards of
the Coast, Inc, and used strictly by permission only.  Please see the <A
HREF="/deckmaster/cards/acknowledgements.html">long acknowledgements</A>
for further details.  <P> <HR noshade width=50%>

<CENTER>
    <big><B>Tom Christiansen</B></big> <BR>
<A HREF="mailto:tchrist@mox.perl.com?subject=MoxPerl Feedback"><code>tchrist@mox.perl.com</code></a>
    <I>or</I>
<A HREF="mailto:tchrist@mox.perl.com?subject=MoxPerl Feedback"><code>tchrist@wizards.com</code></a>
    <BR>
Official Netrep for the <A HREF="/deckmaster/index.html">MoxPerl</A> WWW MtG Database
    <BR>
<I>Wizards of the Coast, Inc.</I>
</CENTER>

EO_ACKS

    use POSIX qw(strftime);
    print strftime("<hr><I>Last MxScreen update: %c (%Z)</I>\n",
	localtime((stat($0))[9]));

}

#############################################################
# notify if new version installed
#############################################################
sub version_check {
    my $last_version = get_param("__Version");
    if ($last_version && $CUR_VERSION > $last_version) {
	oops("This version, $CUR_VERSION, is newer than $last_version,
	      which you started with.  New features may have been added!");
	if ($last_version < 2.021) { exit }
    }
}

#######################################################
# Check only to see whether MSIE 3 is running, which
# autoselects wrongly.  These are also wrong, but aren't
# checked yet.  In fact, they're *really* wrong.  They 
# can't even handle <OPTIONS> with different return values
# than display strings!
#
#   AIR_Mosaic
#   aolbrowser
#   IBM WebExplorer
#   IBrowse/1.16
#   IWENG
#   Lynx/2.3
#   Mozilla/0.94 Beta (Windows)
#   Mozilla/1.1N
#   NCSA Mosaic/2.
#   PRODIGY-WB
#   TCPConnectII/1.0b
#######################################################
sub broken_browser {
    return unless $Query{Agent} =~ /MSIE 3/;

    $Cannot_Do_Selections = 1;

    oops flash(red("Your browser is broken!")), <<EO_BOOBOO;

<P> You appear to be using <i>$Query{Agent}</i>.  This browser has a
known bug processing forms:  If you select nothing from a list widget,
your buggy browser will in a fit of reckless abandon, evilly and secretly
select the top element for you!.  This is <B>very wrong</B> according to
<A HREF="http://www.w3.org/TR/REC-html40/interact/forms.html#h-17.6.1">the
spec</a>.

<P>Please upgrade to <A
HREF="http://www.netscape.com/free/index.html">Netscape</a>, Lynx, Emacs,
Mosaic, Opera, or virtually anything else than <i>$Query{Agent}</i>.
I'm sad to report that until you do so, you won't be able to use this
MoxPerl form to its.

<P> It may prove little solace to you, but you <i>could</i>
just access the <A HREF="/deckmaster/forms/mx-backend.html">real
database</a> directly.  It's infinitely more powerful, but I'm
afraid that you'll have to use your keyboard to type things: it has no <A
HREF="http://www.wins.uva.nl/~mes/jargon/p/point-and-droolinterface.html">point-and-drool</A>
interface.  And you'd better not be afraid of Perl's parentheses and
dollar signs, either <IMG SRC="/deckmaster/gifs/smiley.gif" ALT=":-)">.

<P>Then again, you <I>could</I> simply upgrade to a less broken browser, you know.

<P>Oh, and if you're thinking about MSIE 4, while that version
does in fact fix the selection bug, it has a different bug when
you try to reload these POST-generated CGI forms.  Netscape doesn't
have that bug, nor do the other browsers named above.  Remember <A
HREF="http://language.perl.com/versus/hats.html"><I>Black Hats and
White</I></A> when you make your choice.

EO_BOOBOO

    return 1;
}

#############################################################
# Adjust widget type due to broken browser
# This was a failed attempt!!!
#############################################################
sub fix_msie_lists {
    return \&scrolling_list;
    # this doesn't work: MSIE hoses even checkbox groups!
    $Cannot_Do_Selections
	?  \&checkbox_group
	:  \&scrolling_list
}

####################
# Are they cool?
####################
sub isn't_privileged { !&is_privileged } # silly synonym
sub is_privileged {
    is_registered() 
	|| 
    is_programmer() 
	||
    remote_host =~ /\b(?:wall\.org|(?:perl|wizards)\.com)$/;
}

#############################################################
# trivial check.  the real verifier is in
# the ftpucheck program that gets called out.
#############################################################
sub isn't_registered { !&is_registered } # silly synonym
sub is_registered {
    get_param('login') =~ /\S+\@\S+\.\S+/;
}

#############################################################
# do they appear to be coming from a programmer's system,
# or have they registered?
#############################################################
sub isn't_programmer { !&is_programmer } # silly synonym
sub is_programmer {
    user_agent() =~ m{
			    X11
			|
			    Lynx
			|
			    lwp
                        |
                            HTML\s+Stripper
		    }x;
}


###################################################
# If all they asked was a name query, do a redirect;
# this has to happen before the header!
###################################################
sub redirect_name_query {
    my $qstring = shift || get_user_query();

    if ($qstring =~ m/^\s*(?:lc\()?NAME\(\)+\s*(?:=~|eq)\s*[mq]{([^}]+)}i?\s*$/
	&& param("matchhow Name 1") !~ /regular/i)
	    # don't redirect regex match -- fuzzy uses agrep, not perl.
    {
	require URI::URL;
	my $name = $1;
	$name =~ s/\\b//g;
	warn "Name redirect for $1\n";
	my $url = URI::URL->new("http://mox.perl.com/cgi-bin/pickcards");
	$url->query_form("cardname" => $name);
	print redirect($url);
	exit;
    }

    if (isn't_privileged() && 
	# these haven't been set yet
	get_param("__Count") < 2 && 
	get_param("state") =~ /^name$/i )
    {
	require URI::URL;
	my $url = URI::URL->new("http://mox.perl.com/deckmaster/cards/index.html");
	warn "Name redirect\n";
	print redirect($url);
	exit;
    } 

}

###################################################
# fetch and/or set login id cookie;
# this is a bit tricky because we have to decide
# whether their last screen set a new cookie before
# we can emit the header.  save the cookie in a 
# global variable for the Banner program.
###################################################
sub check_registration {
    my $COOKIE_NAME = "moxperl login";
    my $form_login   = get_param("login");
    my $cookie_login = trim(scalar(cookie($COOKIE_NAME)));

    if ($cookie_login && !$form_login) {
	# just so we can pass it on and use ourselves
	set_param("login", $cookie_login);
    }
    elsif ($form_login && ($cookie_login ne $form_login)) { # change?
	# this is safe because no shell escapes; it's my
	# user@host.com email address ``verifier''.  more
	# robust than any other i've seen, but still provably
	# incorrect for many cases.
	if (system("/usr/local/etc/ftpucheck", $form_login)) {
	    warn "Rejecting bad login $form_login";
	    $Bad_Login = $form_login;  # great, another damned global
	    Delete("login");
	    $form_login = '';
	}
	# yes, if they didn't validate, this gives them 
	# an empty cookie.  i dont' know how to ask to 
	# remove the cookie.
	$Return_Cookie = cookie(-NAME    => $COOKIE_NAME,
				-VALUE   => $form_login,
				-PATH    => '/cgi-bin/',
				-EXPIRES => '+5y',
			 );
    }

}

###################################################
# figure out what card gif images exist, and give
# them a random one (maybe)
###################################################
sub pick_a_pic {
    if ($Query{Count} == 0 || !is_privileged()) {
	return "WarriorAngel.gif";
    } 
    local *DIR;
    unless (opendir(DIR, "/deckmaster/gifs/cards")) {
	warn "can't opendir card images: $!";
	return;
    } 
    my @files = grep { /\.gif$/ } readdir(DIR);
    closedir DIR;

    # Suboptimal rand, only 41 images for now.  I wish there were 43,
    # since optimal hashing count is always N = 4X-1 and where N is
    # also prime.  41 is prime, but not 4N-1.  Oh well.

    return $files[ rand @files ]; 
} 

# Helper function for what comes next
sub color_clash {        
    my $uq = get_user_query();
    oops "@_<P>Please fix your colors so they are logically correct, and try again.";
    warn "Color clash: $uq";
}


####################################################
# Sanity checking for people who can't understand 
# that "gold" just means "more than one color" and
# that "colorless" just means "no color".
####################################################
sub color_check {
    my $bad = 0;

    my $MAX_COLORS = 7;
    my @COLORS = qw{black blue green red white};

    my @yes_colors = get_param("Color included");
    my @not_colors = get_param("Color excluded");
    my $yes_andor  = get_param("Color included Conjunction");
    my $not_andor  = get_param("Color excluded Conjunction");

    my %excluded = map { $_ => 1 } @not_colors;
    my %included = map { $_ => 1 } @yes_colors;

    #my $wasso   = commify_series @yes_colors;
    #my $wasnot  = commify_series @not_colors;
    my $wasso  = commify_series (grep { $included{$_} } @COLORS);
    my $wasnot = commify_series (grep { $excluded{$_} } @COLORS);

    $wasso  =~ s/\band\b/or/ unless $yes_andor =~ /all/;
    $wasnot =~ s/\band\b/or/ unless $not_andor =~ /all/;

    if ($yes_andor =~ /all/ &&  @yes_colors > 1 && $included{"colorless"}) {
	color_clash "How can any card be both colorless and anything else?";
	$bad++;
    } 

    if ($yes_andor =~ /all/ &&  @yes_colors > 1 && $excluded{"gold"}) {
	color_clash "How can any card have more than one color and not be gold?";
	$bad++;
    } 

    if (@yes_colors == 1 && @not_colors == ($MAX_COLORS - 1)) {
	color_clash "Didn't I tell you not to automatically check everything in the
	      excluded column that's not in the included one?";
       $bad++;
    } 

    if ( grep ( { $included{$_} } @COLORS,'gold') && $excluded{"colorless"}) {
	$wasso  = commify_series (grep { $included{$_} } @COLORS, 'gold');
	$wasso  =~ s/\band\b/or/ unless $yes_andor =~ /and/;
	color_clash "I promise that no $wasso card will also be colorless.";
	$bad++;
    } 

    if ($yes_andor =~ /any/ && 6 == grep{ $included{$_} } @COLORS,'colorless') {
	color_clash("Since all cards must either have a color or else be colorless, you have not narrowed your search at all.  You've just invented a complicated way to say nothing.  <B>All</B> Color selections have been cleared!");
	Delete("Color included");
	Delete("Color excluded");
	Delete("Color included Conjunction");
	Delete("Color excluded Conjunction");
	$bad++;
    }

    if (@yes_colors == 1 && $included{"colorless"} && grep{ $excluded{$_} } @COLORS,'gold') {
	color_clash "I promise that no colorless card will have any color.";
	$bad++;
    } 

    if ($included{"gold"} && $yes_andor =~ /all/ && 1 < grep{ $included{$_} } @COLORS) {
	color_clash "I promise that all cards which are $wasso will also be gold.";
	$bad++;
    }

    if ($included{"gold"} && 3 < grep{ $excluded{$_} } @COLORS) {
	if ($not_andor =~ /any/) { 
	    $wasnot =~ s/^/any of /;
	} else {
	    $wasnot =~ s/^/all of /;
	} 
	color_clash "There's no way for a gold card to <i>not</i> be $wasnot.";
	$bad++;
    }

=comment

    if ($wasso and $excluded{"gold"} && grep{ $excluded{$_} } @COLORS) {
	color_clash "I assure you that any card that's $wasso and not gold will also not be $wasnot.";
	$bad++;
    } 

=cut

    if ( $included{'gold'}   &&
	 $yes_andor =~ /any/  &&
	 $not_andor !~ /all/  &&
	 ( grep ({ $included{$_} } @COLORS) 
		+
	  grep ({ $excluded{$_} } @COLORS) ) == 5) 
    {
	my $extra = @not_colors ? " but not $wasnot" : "";
	color_clash "If a card is $wasso$extra, then there's no certainly need to also specify gold.";
	$bad++;
    } 
    return $bad;
}


sub get_my_size {
    my $size = -s $0;
    if ($size) { $size = int($size / 1024) . 'k'; } 
    else       { $size = 'BIG!'; }
    return $size;
}