[Date Prev][Date Next][Thread Prev][Thread Next] [Search] [Date Index] [Thread Index]
[MacPerl] imagemap.pl

To: daver@idiom.com (David Ray)
Subject: [MacPerl] imagemap.pl
From: bpm@terraweb.com (Brian P Millett)
Date: Fri, 08 Mar 1996 15:46:29 -0600
Cc: mpw-perl@iis.ee.ethz.ch
In-Reply-To: <v02140b00ad663d458901@[206.14.80.95]>
References: <v02140b00ad663d458901@[206.14.80.95]>
David Ray writes:
 |Does anybody know if there is a perl-based imagemap program available?
 |
 |If so, where can I download a copy and what are it's caveats?
 |
 |Thanks,
 |
 |Dave
 |
I got this from http://cat.ncsa.uiuc.edu/~jwessel/jhttpd/
enjoy.

#!/usr/local/bin/perl
# imagemap.perl Written by Jason Wessel 08/08/95
# Original source taken from the ncsa dude's HTTPD-1.4 packages
# 0.9 Release of the JHTTPD compliant imagemap code
# You may freely modify this source but don't remove this info.

$CONF_FILE="/usr/local/etc/httpd/conf/imagemap.conf";

$MAXLINE=500;
$MAXVERTS=100;
$MX2=50;
$X=0;
$Y=1;
$LF=10;
$CR=13;
$sawpoint = 0;

sub servererr {
    local($msg) = @_;
    printf("Content-type: text/html%c%c",10,10);
    printf("<title>Mapping Server Error</title>");
    printf("<h1>Mapping Server Error</h1>");
    printf("This server encountered an error:<p>");
    printf("%s", $msg);
    exit(-1);
}

sub isname {
    local($c) = @_;
    return ($c =~ /\S/);
}

# MAIN PROGRAM STARTS HERE
#  char input[MAXLINE], *mapname, def[MAXLINE], conf[MAXLINE], errstr[MAXLINE];
#    double testpoint[2], pointarray[MAXVERTS][2];
#    int i, j, k;
#    FILE *fp;
#    char *t;
#    double dist, mindist;
#    int sawpoint = 0;
    
if ($#ARGV != 0) {
    &servererr("Wrong number of arguments, client may not support ISMAP.");
}
$mapname=$ENV{'PATH_INFO'};

if($mapname eq "") {
    &servererr("No map name given. Please read the <A HREF=\"http://hoohoo.ncsa.uiuc.edu/docs/setup/admin/Imagemap.html\">instructions</A>.<P>");
}

#    mapname++;
if(!($ARGV[0] =~ /,/)) {
    &servererr("Your client doesn't support image mapping properly.");
}
# *t++ = '\0';
$testpoint[$X] = $ARGV[0];
$testpoint[$X] =~ s/(\d.*),.*/$1/;
$testpoint[$X] += 0;
$testpoint[$Y] = $ARGV[0];
$testpoint[$Y] =~ s/.*,(\d.*)/$1/; 
$testpoint[$Y] += 0;

#    /*
#     * if the mapname contains a '/', it represents a unix path -
#     * we get the translated path, and skip reading the configuration file.
#     */

if ($mapname =~ /\//) {
    $conf = $ENV{'PATH_TRANSLATED'};
    goto openconf;
}

if (!(-r $CONF_FILE)) {
    $errstr = sprintf("Couldn't open configuration file: %s", $CONF_FILE);
    &servererr($errstr);
}
open(fp, $CONF_FILE);
while(<fp>) {
    chop($_);
    if((substr($_,0,1) eq '#') || ($_ eq "" )) {
        next;
    }
    ($confname,$conf) = split(/:/,$_);
    $confname =~ s/ //g;
    $conf =~ s/ //g;
    if($confname eq "$tmpmapname") {
        goto found;     
    }
}

$conf = $ENV{'PATH_TRANSLATED'};

found:
    ;
openconf:
    if(!(-r $conf)){
    $errstr = sprintf("Couldn't open configuration file: %s", $conf);
    &servererr($errstr);
}

open(fp, $conf);

while(<fp>) {
#    char type[MAXLINE];
#    char url[MAXLINE];
#    char num[10];
    chop($_);
    if((substr($_,0,1) eq '#') || ($_ eq "" )) {
        next;
    }
    ($type,$url,@numarray) = split(/ +/,$_);

    if($type =~ /default/ && !$sawpoint) {
        $def = $url;
        next;
    }
    $k=0;
    foreach $numel (@numarray) {
        $pointarray[$k + $MX2*$X] = $numel;
        $pointarray[$k + $MX2*$X] =~ s/(\d.*),.*/$1/;
        $pointarray[$k + $MX2*$X] += 0;
        $pointarray[$k + $MX2*$Y] = $numel;
        $pointarray[$k + $MX2*$Y] =~ s/.*,(\d.*)/$1/;
        $pointarray[$k + $MX2*$Y] += 0;
        $k++;
    }
    $pointarray[$k + $MX2*$X] = -1;
    if($type eq "poly") {
        if(&pointinpoly($testpoint[$X],$testpoint[$Y],@pointarray)) {
            &sendmesg($url);
        }
    }
    if($type eq "circle") {
        if(&pointincircle($testpoint[$X],$testpoint[$Y],@pointarray)) {
            &sendmesg($url);
        }
    }
    if($type eq "rect") {
        if(&pointinrect($testpoint[$X],$testpoint[$Y],@pointarray)) {
            &sendmesg($url);
        }
    }
    if($type eq "point") {
#           /* Don't need to take square root. */
        $dist = (($testpoint[$X] - $pointarray[0 + $MX2*$X])
                 * ($testpoint[$X] - $pointarray[0 + $MX2*$X]))
            + (($testpoint[$Y] - $pointarray[0 + $MX2*$Y])
               * ($testpoint[$Y] - $pointarray[0 + $MX2*$Y]));
#           /* If this is the first point, or the nearest, set the default. */
        if ((!$sawpoint) || ($dist < $mindist)) {
            $mindist = $dist;
            $def = $url;
        }
        $sawpoint++;
    }

#    print "$_\n";
}

if ($def ne "") {
    &sendmesg($def);
}
&servererr("No default specified.");
exit(0);
###### END MAIN PROGRAM



sub sendmesg {
    local($url) = @_;
    if ($ENV{'HTML_SERVER'} ne "" || $ENV{'HTML_ANY'} ne "") {
        $url =~ s/\$HTML_SERVER/$ENV{'HTML_SERVER'}/g;
        $url =~ s/\$HTML_ANY/$ENV{'HTML_ANY'}/g;
        $url =~ s/\$HTML_ROOT/$ENV{'HTML_ROOT'}/g;
    }
#  /*** It is a full URL ***/
    if ($url =~ /:/) {
        printf("Location: ");
#    /*** It is a virtual URL ***/
    } else {
        printf("Location: http://%s:%s", $ENV{'SERVER_NAME'}, 
               $ENV{'SERVER_PORT'});
    }
    
    printf("%s%c%c",$url,10,10);
    printf("This document has moved <A HREF=\"%s\">here</A>%c",$url,10);
    exit(1);
}

sub pointinrect {
    local($point[$X],$point[$Y],@coords) = @_;
    return (($point[$X] >= $coords[0 + $MX2*$X] && $point[$X] <= $coords[1 + $MX2*$X]) &&
            ($point[$Y] >= $coords[0 + $MX2*$Y] && $point[$Y] <= $coords[1 + $MX2*$Y]));
}

sub pointincircle {
    local($point[$X],$point[$Y],@coords) = @_;
    $radius1 = (($coords[0 + $MX2*$Y]  - $coords[1 + $MX2*$Y]) * 
                ($coords[0 + $MX2*$Y]  - $coords[1 + $MX2*$Y])) + 
                (($coords[0 + $MX2*$X] - $coords[1 + $MX2*$X]) * 
                 ($coords[0 + $MX2*$X] - $coords[1 + $MX2*$X]));
    $radius2 = (($coords[0 + $MX2*$Y]  - $point[$Y]) * 
                ($coords[0 + $MX2*$Y]  - $point[$Y])) +
                (($coords[0 + $MX2*$X] - $point[$X]) * 
                 ($coords[0 + $MX2*$X] - $point[$X]));
    return ($radius2 <= $radius1);
}

sub pointinpoly {
    local($point[$X],$point[$Y],@pgon) = @_;
#    int i, numverts, inside_flag, xflag0;
#   int crossings;
#    double *p, *stop;
#    double tx, ty, y;

    for ($i = 0; $pgon[$i + $MX2*$X] != -1 && $i < $MAXVERTS; $i++) {
        ;
    }
        $numverts = $i;
        $crossings = 0;

        $tx = $point[$X];
        $ty = $point[$Y];
        $y = $pgon[$numverts - 1 + $MX2*$Y];

        $p = $pgon[0 + $MX2*$Y];
        if (($y >= $ty) != ($p >= $ty)) {
                if (($xflag0 = ($pgon[$numverts - 1 + $MX2*$X] >= $tx)) ==
                ($pgon[0 + $MX2*$X] >= $tx)) {
                    if ($xflag0) {
                        $crossings++;
                    }
                }
                else {
                    $crossings += ($pgon[$numverts - 1 + $MX2*$X] - ($y - $ty) *
                                   ($pgon[0 + $MX2*$X] - $pgon[$numverts - 1 + $MX2*$X]) /
                                   ($p - $y)) >= $tx;
                }
        }

    $stop = $numverts;
    $p = 0;
    for ($y = $pgon[$p + $MX2*$Y], $p += 1; $p < $stop; $y = $pgon[$p + $MX2*$Y], $p += 1) {
        if ($y >= $ty) {
            while (($p < $stop) && ($pgon[$p + $MX2*$Y] >= $ty)) {
                $p += 1;
            }
            if ($p >= $stop) {
                last;
            }
            if (($xflag0 = ($pgon[$p - 1 + $MX2*$X] >= $tx)) == ($pgon[$p + $MX2*$X] >= $tx)) {
                if ($xflag0) {
                    $crossings++;
                }
            } else {
                $crossings += ($pgon[$p - 1 + $MX2*$X] - ($pgon[$p - 1 + $MX2*$Y] - $ty) *
                               ($pgon[$p + $MX2*$X] - $pgon[$p - 1 + $MX2*$X]) / 
                               ($pgon[$p + $MX2*$Y] - $pgon[$p - 1 + $MX2*$Y])) >= $tx;
            }
        } else {
            while (($p < $stop) && ($pgon[$p + $MX2*$Y] < $ty)) {
                $p += 1;
            }
            if ($p >= $stop) {
                last;
            }
            if (($xflag0 = ($pgon[$p - 1 + $MX2*$X] >= $tx)) == ($pgon[$p + $MX2*$X] >= $tx)) {
                if ($xflag0) {
                    $crossings++;
                }
            } else {
                $crossings += ($pgon[$p - 1 + $MX2*$X] - ($pgon[$p - 1 + $MX2*$Y] - $ty) *
                              ($pgon[$p + $MX2*$X] - $pgon[$p - 1 + $MX2*$X]) / 
                               ($pgon[$p + $MX2*$Y] - $pgon[$p - 1 + $MX2*$Y])) >= $tx;
            }
        }
    }
    $inside_flag = $crossings & 0x01;
    return ($inside_flag);
}

---
Brian Millett                    
Technology Applications Inc.     "Heaven can not exist,
(314) 530-1981                          If the family is not eternal"
bpm@techapp.com                   F. Ballard Washburn
References:
- [MacPerl] imagemap.pl
  - From: daver@idiom.com (David Ray)
Prev by Date: [MacPerl] imagemap.pl
Next by Date: Re: [MacPerl] imagemap.pl
Prev by thread: [MacPerl] imagemap.pl
Next by thread: Re: [MacPerl] imagemap.pl
Navigation: Date Index | Thread Index | Search | Other lists at bumppo.net