#
# decode.pl --- image selection decoder
#
# decode.pl,v 2.9 1993/09/09 oscar@cui.unige.ch
#
# MODIFIED by Oscar Nierstrasz to directly use the path to the map
# file as an argument, rather than looking it up in map.conf.
# Map.conf is no longer necessary.  To add new mapped images,
# it is no longer necessary to map lines on local.conf.
# Simply use the URL: /decode-map/map-path, where map-path is the
# path-name of the map file.  You will only need the following
# line in local.conf:
#
# map	decode-map	decode.pl	&do_decode($rest, $query)
#
# For backwards compatibility, map-handles can still be introduced in
# local.conf, e.g.:
#
# map	decode-walk	decode.pl	&do_decode("server/walk/walk.map", $query)
#
# also added &mapget -- a hack to handle GIF files: if the URL to open
# is a GIF file, &mapget will return an href to that file rather than
# simply returning the file.  This seems to be the only way to let
# Xmosaic know that the result is a GIF image and not HTML!
#
# decode.pl,v 2.8 1993/08/31 18:18:14 sanders Exp
#
# Chris McRae <mcrae@ckm.ucsf.edu>, May 1993
# bitmasks added by Tony Sanders <sanders@bsdi.com>, June 1993
#
# This is the support code for decoding images.
#
# FYI about bitmasks:
#   For large images using masks you'll want to scale the mask by some factor
#   depending on how accurate the results must be.  It would be better to
#   have a ppm style mask with each "color" being a different object.  If
#   you write this let me know.  Currently you need a mask for each object.
#   The code doesn't currently support this.
#	map_handle pixmask pixmap_file color1 URL1 [menu desc]
#	map_handle pixmask pixmap_file color2 URL2 [menu desc]
#
# &do_decode -- decides what to do (rectangle decoding is built-in)
# &region -- front end to &loadmask and &pixel that caches bitmasks
# &loadmask -- reads the image file into memory
# &pixel -- test if a pixel is set, image must already be loaded by &loadmask
# &rnd -- internal routine for &loadmask for rounding up to nearest byte
#
# XXX: executable URLs
# XXX: scaled bitmasks
#

# Example config lines:
# $map{'decode'} = '&do_decode($path, $query)';

sub do_decode {
    local($map_path, $query) = @_;
    local($_, @lines, @menu) = (defined($query) && $query);
    local($X, $Y) = split(',', $_);			# unpack $query: x,y
    # local($map_config_file) = $plexus{'decode_config'};
    local($map_config_file) = $map_path;
    local($title) = "Object menu for image: $map_path";

    MAP_OPEN: {
	# extract lines from MAP for this object ($map_path)
	@lines = ();
	&open(MAP, $map_config_file) || die "$map_config_file: $!";
	while (<MAP>) { /^\s*\w/ && push(@lines, $_); }
	close(MAP);

	# map_handle default URL
	# map_handle title default_title_for_automenu
	# map_handle config-file map_config_file
	# map_handle bitmask bitmask_file width height URL [menu desc]
	# map_handle rect x y width height URL [menu desc]
	foreach (@lines) {
	    split(" ");					# into @_

	    if ($_[1] =~ /default/i) {
		return &mapget($_[2]) unless defined($query);
	    } elsif ($_[1] =~ /title/i) {
		shift @_; shift @_; $title = join(" ", @_);
	    } elsif ($_[1] =~ /config-file/i) {
		# redirect to another file
		&error('internal_error', "too many lines for $map_path in $map_config_file")
		    unless $#lines == 0;		# only one allowed
		$map_config_file = $_[2];
		redo MAP_OPEN;
	    } elsif ($_[1] =~ /bitmask/i) {
		# decode by bitmask
		local($bitmask, $w, $h, $URL) = @_[2..5];
		unless (defined($query)) {
		    splice(@_,0,6,());			# delete 0..6
		    push(@menu, join(" ", ($URL, @_)));	# rest is menu text
		    next;
		}
		# XXX: Need to embed width and height in the mask file
		&region($bitmask, $w, $h, $X, $Y) && return &mapget($URL);
	    } elsif ($_[1] =~ /rect/i) {
		# decode by rectangle
		local($x, $y, $w, $h, $URL) = @_[2..6];
		unless (defined($query)) {
		    splice(@_,0,7,());			# delete 0..7
		    push(@menu, join(" ", ($URL, @_)));	# rest is menu text
		    next;
		}
		if (($x < $X) && (($x+$w) > $X) &&
		        ($y < $Y) && (($y+$h) > $Y)) {
		    return &mapget($URL);
		}
	    }
	}
    }
    # No $query or nothing found -- this menu will only contain
    # the elements in the last config file read.
    &MIME_header('ok', 'text/html');
    print "<HEAD>\n<TITLE>$title</TITLE>\n</HEAD>\n";
    print "<BODY>\nYou can select one of:\n<UL>\n";
    foreach (@menu) {
	split(" ", $_, 2);
	print "<LI> <A HREF=\"$_[0]\">$_[1]</A>\n";
    }
    print "</UL>\n</BODY>\n";
}

# If the URL is a GIF image, wrap it up so that Xmosaic doesn't
# treat it as HTML text!
sub mapget {
	local($file) = @_;
	if ($file =~ /\.gif$/) {
		if ($file =~ /^http:/ ) { $href = $file; }
		else { $href = "/$file"; }
		print "<TITLE>GIF file $file</TITLE>\n",
		"<A HREF=\"$href\">\n<IMG SRC=\"$href\"></A>\n";
		# print "<TITLE>GIF file $file</TITLE>\n<IMG SRC=\"$href\">\n";
		# print "<TITLE>Link to GIF file $file</TITLE>\n",
		# "<B>Click to view:</B>\n<A HREF=\"$href\">$file</A><P>\n";
	}
	else { &retrieve($file); }
}

sub rnd { local($value, $incr) = @_; ($value + ($incr-1)) & ~($incr-1); }

sub loadmask {
    local(*image) = @_;
    local($bits);	# because perl can't sysread into $image{'bits'}
    $image{'scanlen'} = &rnd($image{'width'}, 8);	# whole bytes
    open(BITS, $image{'filename'}) || die "$image{'filename'}: $!";
    sysread(BITS, $bits, $image{'scanlen'} * $image{'height'} / 8);
    close(BITS);
    $image{'bits'} = $bits;
}

sub pixel {
    local(*image, $x, $y) = @_;
    local($offset) = int((($y * $image{'scanlen'}) + $x)/8);
    local($byte) = unpack("c", substr($image{'bits'}, $offset, 4)) & 0xff;
    return (($byte & (1<<($x%8))) != 0);
}

$imgatom = "img000";				# generate unique names
%imgatom = ();

sub region {
    local($file, $width, $height, $x, $y) = @_;
    local($a);

    # cached?
    defined($a = $imgatom{$file}) || do {
	$a = $imgatom{$file} = $imgatom++;		# string increment
	eval "
	    \$$a{'filename'} = \$file;
	    \$$a{'width'} = \$width;
	    \$$a{'height'} = \$height;
	    &main'loadmask(*$a);";
	die $@ if $@;
    };
    return eval "&main'pixel(*$a, \$x, \$y)";
}

1;