# fine_likert.pl
# Original by Kieran Mathieson <mathieso@oakland.edu>
# Perl port by Andrew Perrin <andrew_perrin@unc.edu>
# See original idea, ASP code, license, and documentation at:
#  http://www.sba.oakland.edu/faculty/mathieson/research/slider_sim/implementation_paper/fgl_implmentation.htm
# Perl implementation copyright (c) 2003 Andrew J. Perrin.
# All rights reserved.
#
# You may use and redistribute the Perl code under the terms of your
#     choice of the Perl Artistic License:
#  http://www.perl.com/pub/a/language/misc/Artistic.html
#     or the Gnu Public License:
#  http://www.gnu.org/licenses/gpl.html
#
# You'll need the collection of gifs to make this work. You can find them
# from http://www.unc.edu/~aperrin/tips/src/likert_gifs.zip or
#      http://www.unc.edu/~aperrin/tips/src/likert_gifs.tgz
#
# Usage: (assumes this file saved in @INC path as fine_likert.pl)
#        (options are passed via hashref [preferred] or assumed @_)
#        (all options are optional; see defaults below)
#
# require 'fine_likert.pl';
# ...
# print fine_likert({-tickwidthpixels   => ..,
#                    -cellheightpixels  => ..,
#                    -minvalue          => .., #beginning of range
#                    -maxvalue          => .., #end of range
#                    -ticksperunitvalue => .., #possible options between values
#                    -labels            => [..], #arrayref of unit labels
#                    -showvalue         => .., #include a text box with selection?
#                    -name              => .., #CGI variable name for value
#                    -gifserver         => .., #Where to find the GIFs needed
#                    -formname          => ..}); #Name (from <form name="..">)
#                                                #of form scale is on


sub fine_likert {
    my $param = {-tickwidthpixels => 3,
		 -cellheightpixels => 21,
		 -minvalue => 1,
		 -maxvalue => 5,
		 -ticksperunitvalue => 30,
		 -labels => [],
		 -showvalue => 0,
		 -name => 'val',
		 -gifserver => "",
		 -formname  => "f"
		};
    my $p;
    unless (ref($_[0]) eq 'HASH') { # make @_ into hash
	$p = {@_};
    } else {
	$p = shift;
    }
    $param->{$_} = $p->{$_} for keys %$p;
    $param->{-valuerange} = $param->{-maxvalue} - $param->{-minvalue};
    for my $i (0..$param->{-valuerange}) {
	$param->{-labels}->[$i] = $i unless defined $param->{-labels}->[$i];
    }
    if ($param->{-gifserver} and substr($param->{-gifserver}, -1, 1)
	ne "/") {
	$param->{-gifserver} = "$param->{-gifserver}/";
    }
    my @out;
    push @out, <<ESCRIPT;
<SCRIPT>
var oldImage;
var oldTickNumber;
var bFirstTimeThru = true;
function makeTick(tickNumber) {
  var tickName;
  document.$param->{-formname}.$param->{-name}.value = tickNumber / 30 + 1;
  tickName = 'tick' + tickNumber;
  if (!bFirstTimeThru)
        eval('document.$param->{-formname}.tick' + oldTickNumber + '.src = oldImage');
  oldImage = eval('document.$param->{-formname}.' + tickName + '.src');
  oldTickNumber = tickNumber;
  bFirstTimeThru = false;
  eval('document.$param->{-formname}.'+tickName+'.src="$param->{-gifserver}1x1_red.gif"');
}
</SCRIPT>
ESCRIPT
    push(@out, ('<table cellpadding=0 cellspacing=0>',
		'<tr>')
	);
    #Write out the first table - the scale
    #Write out a cell that is half a scale unit value
    push(@out, "<td><img src='$param->{-gifserver}1x1_trans.gif' width=" .
	 $param->{-ticksperunitvalue} / 2 * $param->{-tickwidthpixels} .
	 " height=$param->{-cellheightpixels}></td>");
    #Write out each scale interval
    for my $i (0..$param->{-valuerange} - 1) {
	#Black tick to start it
	push(@out, "<td><img src='$param->{-gifserver}1x1_black.gif' name='tick" .
	     $i  * $param->{-ticksperunitvalue} .
	     "' height=$param->{-cellheightpixels} width=" .
	     "$param->{-tickwidthpixels} border=0 onclick='makeTick(" .
	     $i * $param->{-ticksperunitvalue} . ")'></td>");
	#Now regular ticks for the rest of the scale interval
	for my $j (1 .. $param->{-ticksperunitvalue} - 1) {
	    push(@out, 
		 "<td><img src='$param->{-gifserver}scale.gif' name='tick" .
		 ($i * $param->{-ticksperunitvalue} + $j) .
		 "' height=$param->{-cellheightpixels} width=" .
		 "$param->{-tickwidthpixels} border=0 onclick='" .
		 "makeTick(" . ($i * $param->{-ticksperunitvalue} + $j) .
		 ")'></td>");
	} # $j
    } # $i
    # Write out final tick
    push(@out, "<td><img src='$param->{-gifserver}1x1_black.gif' name='tick" .
	 $param->{-valuerange} * $param->{-ticksperunitvalue} .
	 "' height=$param->{-cellheightpixels} " .
	 "width=$param->{-tickwidthpixels} border=0 onclick=makeTick(" .
	 $param->{-valuerange} * $param->{-ticksperunitvalue} .
	 ")'></td>");
    #Write out a cell that is half a unit value
    push(@out, "<td><img src='$param->{-gifserver}1x1_trans.gif' width=" .
	 $param->{-ticksperunitvalue} / 2 * $param->{-tickwidthpixels} .
	 " border = 0></td>");
    push(@out,("</tr>",
	       '</table>',
	       '<table cellpadding=0 cellspacing=0>',
	       '<tr>'));
    #Write out the label table
    for my $i (0 .. $param->{-valuerange}) {
	push(@out, "<td align='center' valign='top' width=" .
	     $param->{-ticksperunitvalue} * $param->{-tickwidthpixels} .
	     ">$param->{-labels}->[$i]</td>");
    }
    push(@out,('</tr>',
	       '</table>'));
    if ($param->{-showvalue}) {
	push(@out, "<input type=text name=$param->{-name}>");
    } else {
	push(@out, "<input type=hidden name=$param->{-name}>");
    }
    return join("\n",@out);
}

1;