/* ------------------- Mappable images processor -----------------------------*/
/* a server side image map procedure, for use with the sreLite2 www server
.
.   The bulk of this (the READMAP, GetURLfromMAP, and CrossingsMultiplyTest)
.   was taken pretty much verbatim from the GOHTTP package:
.       "GoHTTP REXX Filter Script for GoServe v2.00+ for OS/2
.        by Donald L. Meyer

.    A NSCA or CERN style MAP file is expected, which should contain
.    instructions as to what regions of the image map to
.    what urls.  Four types of regions are recognized:
.       rectangles, polygons, points.
    If the selected point falls within a circle, rectangle, or polygon,
.    or it's exactly on a point, then we have a direct match.  If this doesn't
.    occur, and there are points selected, then it is assigned to the closest point,
.    given that the distance to this closest point is less then max_pointdist (in pixel)
.    If none of these satisfied, then use default_url.


Ncsa style map:
rect recthead.1 109,10 183,68 
circle shoucirc.1 75,103 112,122 
poly poly.1  57,191 47,187 41,189 41,189 38,191 38,191 38,192
default defa.1

cern style map:
rect (109,10) (183,68) recthead.1
circle (75,103) 41 shoucirc.1
poly  (62,190) (57,191) (47,187) (41,189) (41,189) (38,191) (38,191) (38,192) poly.1
default defa.1


*/
/* -------------------------------------------------------------*/

/* ----------------------------------------------------------------------- */
/*  Main routine for processing mappable images respones */
/* ----------------------------------------------------------------------- */

mapimage:

signal on novalue name oof

signal on error name oof2
signal on syntax name oof2

parse arg list,servername,verb,tempfile,,
          prog_file,reqnum,verbose,user,privset,,
          uri,host_nickname,id_info

/*parse arg  ddir, tempfile, reqstrg,list,verb ,uri,user, ,
          basedir ,workdir,privset,enmadd,transaction,verbose, ,
         servername,host_nickname,homedir,aparam,semqueue,prog_file,reqnum */

/* some defaults */
maptype='NCSA'
max_pointdist=50
default_url=""

serverport=sre_extract('serverport')
dir=sre_datadir()
/* alis is, where xxx is IMAGE or CERN (IMAGE implies NCSA): 
    '/MAPxxxx/ *  /MAPIMAGE?TYPE=NCSA&PATH=*&XY=*
*/
list=sre_packur(list)
parse var list a1 '?' a2
list=a1'&XY='a2
do until list=''
  parse var list a1 '&' list
  parse var a1 avar '=' aval
  avar=strip(translate(avar))
  if avar='TYPE' then maptype=aval
  if avar='MAP' then mapfile0=strip(aval)
  if avar='XY'  then 
       parse var aval ax ',' ay
end /* do */
/* mapfile,awords, servername, serverport, tempfile, dir,
   max_pointdist,verbose,seluse,maptype  */
if datatype(ax)<>"NUM" | datatype(ay)<>"NUM" then signal noxy
mapfile=strip(translate(dir,'\','/'),,'\')||'\'||strip(translate(mapfile0,'\','/'),,'\')


/* check for mapfile, or mapfile.map */
      aa=stream(mapfile,'c','query exists')
      if aa="" & pos('.',mapfile)=0 then do   /* add .map if non existent map file and no . */
            mapfile=mapfile'.MAP'
       end
      ain=sre_read_file(mapfile,2,2)
      if ain='' then signal nomap
      ain=translate(ain,' ','1a01'x)
      JJ=0
      DO while ain<>''
           jj=jj+1
           parse var ain filelines.jj '0d0a'x ain
      end 
      filelines.0=jj
      if jj=0 then signal nomap      /* no such map file */
              
      bbpath=filespec('p',mapfile0)
      region.0=0
      nr2=readmap()   /* sets default_url and Region,
                         expects filelines. servername port */

      if nr2=0 & default_url="" then signal nourl
          if VERBOSE>1 then 
           foo=sre_pmprintf(" Using mapfile: " mapfile " , # regions=" region.nregions)

      message=geturlfrommap(ax, ay)
      if message="" then signal nomatch   /* could not find a url */

/* add base url path (from the mapimage/xxx/foo.map request string)
   if needed */
      poo=strip(translate(upper(message),'/','\'))
      select
        when pos('/',poo)=0 then        /* no /, must be in mapfile directory */
             message=bbpath||message
        when pos('HTTP://',poo)>0 | abbrev(poo,'/')=1 then
                nop
        when pos('.',poo)> pos('/',poo) then
                message=bbpath||message
        otherwise
           nop
      end
      
    rcode =sre_move_response(302,message,servername,serverport,0,uri)
    if VERBOSE>1 then  call pmprintf(" Moved to Url: " message)
    return rcode


  /* error returns ... */
nourl:                  /* jump here if no such url found */
   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'

  call lineout tempfile, "<html><head><title> No such matching URL </title>"
  call lineout tempfile, "</head>"
  call lineout tempfile, "<body><h2>Could not find any URLS.</h2>"
  call lineout tempfile, ' No URLS were listed in the "map" file ' mapfile0
  call lineout tempfile, ' </body> </html> '
  if VERBOSE>0 then call pmprintf(" Empty mapfile: " mapfile)
  call lineout tempfile
  rcode=sre_command('FILE ERASE TYPE text/html NAME 'tempfile)
  return rcode


nomatch:                  /* jump here if no url found */
   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'

  call lineout tempfile, "<html><head><title> No  URL selected </title>"
  call lineout tempfile, "</head>"
  call lineout tempfile, "<body><h2>A URL was not selected</h2>"
  call lineout tempfile, ' You selected a region NOT associated with a URL: ' ax ay
  call lineout tempfile, ' </body> </html> '
  call lineout tempfile
  foo=stream(tempfile,'c','query size')
  if VERBOSE>0 then foo=sre_pmprintf(' No URL match: ' ax' ' ay' ' mapfile)
  rcode=sre_command('FILE ERASE TYPE text/html NAME 'tempfile)
  return rcode

nomap:
   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'

  call lineout tempfile, "<html><head><title> No such MAP file </title>"
  call lineout tempfile, "</head>"
  call lineout tempfile, "<body><h2>Could not find MAP file.</h2>"
  call lineout tempfile, ' The "map" file ' mapfile0 ' could not be found.'
  call lineout tempfile, ' </body> </html> '
  call lineout tempfile
  if VERBOSE>0 then foo=sre_pmprintF(' No such mapfile: ' mapfile)
  rcode=sre_command('FILE ERASE TYPE text/html NAME 'tempfile)
  return rcode

emptymap:
   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'

  call lineout tempfile, "<html><head><title> No regions defined in MAP file </title>"
  call lineout tempfile, "</head>"
  call lineout tempfile, "<body><h2>Could not use MAP file.</h2>"
  call lineout tempfile, ' The "map" file ' mapfile0 ' had no defined regions.'
  call lineout tempfile, ' </body> </html> '
  call lineout tempfile
  if VERBOSE>0 then foo=sre_pmprintF(' No such mapfile: ' mapfile)
  rcode=sre_command('FILE ERASE TYPE text/html NAME 'tempfile)
  return rcode


noxy:                           /* invalid x y */
   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'

  call lineout tempfile, "<html><head><title> Bad location </title>"
  call lineout tempfile, "</head>"
  call lineout tempfile, "<body><h2>Invalid pixel location given.</h2>"
  call lineout tempfile, ' The location given is invalid:' ax " , " ay
  call lineout tempfile, ' </body> </html> '
  call lineout tempfile

  if VERBOSE>0 then foo=sre_pmprintf(' Bad x y: ' ax' ' ay)
  rcode=sre_command('FILE ERASE TYPE text/html NAME 'tempfile)
  return rcode





/* ----------------------------------------------------------------------- */
/* READMAP: Read in the .MAP file into a stem variable.
.    The stem variable Region. gets filled up with "region" info.
.    Also, the default_url gets set (if a DEFAULT line is found)           */
/* ----------------------------------------------------------------------- */

readMap: procedure expose Region. Default_URL filelines.  ServerName Port verbose maptype

        /* Initilizations */
   i = 0
   nR = 0
   strongchecks=1               /* always check for proper syntax */
   Text = '%'
   Default_URL = ''

/* read file into filelines. array */


        /* read in the region definitions from the .MAP file.  */
   do jj=1 to filelines.0
     text=strip(filelines.jj)
     if text="" then iterate            /* ignore blank lines */
     if  left(Text,1)= '#' then iterate  /* # starts a comment line */

     i = i + 1

     parse var Text Text '#' comments   /* trim any comments   */
     r = right(Text,1)
     l = left(comments,1)
     if (((r \= ' ') & (r \= '') & (r \= '09'x)) & ((l \= ' ') & (l \= '') & (l \= '09'x))) then do
        parse var comments comments'#'rest      /* trim any comments, again   */
        Text = Text'#'comments
     end


/* a hack to deal with cern maps */
    if maptype="CERN" then do
       atext=translate(text,' ','()')
       if words(text)> 2 then do        /* if 2, same syntax */
           nw=words(text)
           t1=word(text,1); t3=word(text,nw)
           if upper(t1)="CIRCLE" then t1="CIRC"
           t2=translate(subword(text,2,nw-2),' ','()')
           text=t1||' '||t3||' '||t2
        end
     end
     parse var Text T  Region.URL.i  Cs
     parse var Cs C1 C2
     parse upper var T Region.Type.i

     parse var Text T  Region.URL.i  Cs
     parse var Cs C1 C2
     parse upper var T Region.Type.i



     Err = 0
     Select


        /* DEFAULT keyword sets the default URL to redirect to in case of no region matches. */
       When (Region.Type.i = 'DEFAULT') then do
           Default_URL = Region.URL.i
           i = i - 1
         end

        /* Parse out coordinates for the Rectangular region.  */
       When (Region.Type.i = 'RECT') then do
           parse var C1 Region.X1.i ',' Region.Y1.i
           parse var C2 Region.X2.i ',' Region.Y2.i
           if (StrongChecks) then do
              if ((Datatype(Region.X1.i) \= 'NUM') | (Datatype(Region.Y1.i) \= 'NUM') | (Datatype(Region.X2.i) \= 'NUM') | (Datatype(Region.Y2.i) \= 'NUM')) then Err = 11
           end

           if (Err == 0) then do
              nR = nR + 1
        /* ensure that X1,Y1 is upper left, and X2,Y2 is lower right... */
              if (Region.X2.i < Region.X1.i) then       /* Swap... */
               do 1
                 a = Region.X2.i
                 Region.X2.i = Region.X1.i
                 Region.X1.i = a
               end
              if (Region.Y2.i < Region.Y1.i) then       /* Swap... */
               do
                 a = Region.Y2.i
                 Region.Y2.i = Region.Y1.i
                 Region.Y1.i = a
               end
            end
         end

        /* Parse out coordinates for the Circle region.  */
       When (Region.Type.i = 'CIRC') then do
           parse var C1 Region.X1.i ',' Region.Y1.i
                /* radius... */
           Region.X2.i = C2
           if (StrongChecks) then do
              if ((Datatype(Region.X1.i) \= 'NUM') | (Datatype(Region.Y1.i) \= 'NUM') | (Datatype(Region.X2.i) \= 'NUM')) then Err = 12
           end
           if (Err == 0) then do
              Region.radius2.i = (Region.X2.i**2)
              nR = nR + 1
           end
         end

        /* Parse out coordinates for the Circle region.  */
       When (Region.Type.i = 'CIRCLE') then do
           parse var C1 Region.X1.i ',' Region.Y1.i
           parse var C2 Region.X2.i ',' Region.Y2.i

           if (StrongChecks) then do
              if ((Datatype(Region.X1.i) \= 'NUM') | (Datatype(Region.Y1.i) \= 'NUM') | (Datatype(Region.X2.i) \= 'NUM') | (Datatype(Region.Y2.i) \= 'NUM')) then Err = 13
           end

           if (Err == 0) then do
                /* radius... */
              qX = (Region.X1.i - Region.X2.i)
              qY = (Region.Y1.i - Region.Y2.i)
              Region.radius2.i = (qX*qX) + (qY*qY)
              nR = nR + 1
           end
         end

        /* handle the Poly region.  */
       When (Region.Type.i = 'POLY') then do
           k=1
           do while (strip(Cs) \= '') & (Err == 0)
              parse var Cs Region.X.i.k ',' Region.Y.i.k Cs
              if (StrongChecks) then if ((Datatype(Region.X.i.k) \= 'NUM') | (Datatype(Region.Y.i.k) \= 'NUM')) then Err = 14
              k = k + 1
           end

           if (Err == 0) then do
              Region.NVerts.i = (k - 1)
              Region.X.i.k = -1
              nR = nR + 1
           end

         end

        /* handle the Point region.  */
       When (Region.Type.i = 'POINT') then do
           parse var C1 Region.X1.i ',' Region.Y1.i
           if (StrongChecks) then do
              if ((Datatype(Region.X1.i) \= 'NUM') | (Datatype(Region.Y1.i) \= 'NUM')) then Err = 15
           end
           if (Err == 0) then nR = nR + 1
         end

        /* handle the standard blank line between 'Default' line and other regions... */
       When (Region.Type.i = '') then do
           if ((i = 1) & (Default_URL \= '')) then do
              Text = '%'
              i = i - 1
            end
         end

        /* Must be an unknown region type... */
       Otherwise do
           if (Text \= '') then
              if VERBOSE>0 then call pmprintf('Unknown RegionType=['Region.Type.i']  URL=<'Region.URL.i'>  [C1='C1'  C2='C2']')
           i = i - 1
         end
     end /* Select */
     if (Err <> 0) then 
         if VERBOSE>0 then call pmprintf('error:  'err' region #'i)
     if (Err == 1) then i = i - 1
   end
   Region.NRegions = nR
   return nR


/* ----------------------------------------------------------------------- */
/* GetURLfromMap: Identify the region of the map, & return the associated URL */
/* ----------------------------------------------------------------------- */

GetURLfromMap: procedure expose Region. Default_URL max_pointdist verbose

        /* Parse out mouse click coordinates */
   parse arg tX , tY

   i = 1;   Hit = 0;  sawpoint = 0

        /* Set URL to the default, in case no regions are hit... */
   _URL = Default_URL

        /* if tX & tY = '', then assume web client not imagemap capable - bypass region search. */
   if (tX='') then Hit = -1


        /* Loop through the defined regions to find first hit. */
   do while ((i <= Region.NRegions) & (Hit = 0))
     Select

        /* Determine if coordinates lie within the rectangular area.  */
       When Region.Type.i = 'RECT' then do
          Hit = ((tX >= Region.X1.i) & (tY >= Region.Y1.i) & (tX <= Region.X2.i) & (tY <= Region.Y2.i))
        end

        /* Calc distance to coordinates from Circle center, and compare to radius.*/
        /*   If less than radius, then it's a hit... */
       When (Region.Type.i = 'CIRC') | (Region.Type.i = 'CIRCLE') then do
          a = tX - Region.X1.i
          b = tY - Region.Y1.i
          R = a**2 + b**2
          Hit = (R <= Region.radius2.i)
        end

        /* Determine if coordinates lie within the polygon.  */
       When Region.Type.i = 'POLY' then do
           Hit = CrossingsMultiplyTest(i, tX, tY)
        end

       When Region.Type.i = 'POINT' then do
          a = tX - Region.X1.i
          b = tY - Region.Y1.i
          R = (a * a) + (b * b)
        /* If a direct hit, then don't bother with nearest determinations... */
          if (R == 0) then Hit = 1
        /* otherwise, track to find which point is nearest the click coordinates... */
          else if (sawpoint) then do
             if (R < PointDistance) then do
                PointDistance = R
                ClosestPoint = i
             end
          end
          else do
             sawpoint = 1
             PointDistance = R
             ClosestPoint = i
          end
        end


        /* The required 'Otherwise'... */
       Otherwise  do
        end
     End /* Select */

        /* If a hit, then set '_URL' to stem URL value.  */
     if (Hit = 1) then do
           _URL = Region.URL.i
     end
     i = i + 1
   end

   if (Hit == 0) then do
      if (sawpoint) & (pointdistance < (max_pointdist*max_pointdist)) then do
        _URL = Region.URL.ClosestPoint
      end
   end

   return _URL          /* return the identified URL */

/* ----------------------------------------------------------------------- */
/* ======= Crossings Multiply algorithm ===================================
.    point in polygon inside/outside code.
.  Original C code by Eric Haines, 3D/Eye Inc, erich@eye.com
.  based on work by Joseph Samosky and Mark Haigh-Hutchinson.
.  Ported to REXX for this filter by D.L. Meyer, meyer@larch.ag.uiuc.edu
*/
/* ----------------------------------------------------------------------- */

CrossingsMultiplyTest: Procedure expose Region. verbose
    parse arg pgon, pointX, pointY

    numverts = Region.NVerts.pgon
    vtx0X = Region.X.pgon.numverts
    vtx0Y = Region.Y.pgon.numverts
    /* get test bit for above/below X axis */
    yflag0 = ( vtx0Y >= pointY )

    inside_flag = 0
    do j = 1 to numverts
              vtx1X = Region.X.pgon.j
              vtx1Y = Region.Y.pgon.j

        yflag1 = ( vtx1Y >= pointY )
        /* Check if endpoints straddle (are on opposite sides) of X axis
         * (i.e. the Y's differ); if so, +X ray could intersect this edge.
         * The old test also checked whether the endpoints are both to the
         * right or to the left of the test point.  However, given the faster
         * intersection point computation used below, this test was found to
         * be a break-even proposition for most polygons and a loser for
         * triangles (where 50% or more of the edges which survive this test
         * will cross quadrants and so have to have the X intersection computed
         * anyway).  I credit Joseph Samosky with inspiring me to try dropping
         * the "both left or both right" part of my code.
         */
        if ( yflag0 \= yflag1 ) then do
            /* Check intersection of pgon segment with +X ray.
             * Note if >= point's X; if so, the ray hits it.
             * The division operation is avoided for the ">=" test by checking
             * the sign of the first vertex wrto the test point; idea inspired
             * by Joseph Samosky's and Mark Haigh-Hutchinson's different
             * polygon inclusion tests.
             */
            if ( (((vtx1Y-pointY) * (vtx0X-vtx1X)) >= ((vtx1X-pointX) * (vtx0Y-vtx1Y))) == yflag1 ) then do
                inside_flag = (inside_flag  == 0)
            end
        end

        /* Move to the next pair of vertices, retaining info as possible. */
        yflag0 = yflag1
        vtx0X = vtx1X
        vtx0Y = vtx1Y

    end

    return  inside_flag



oof:
call pmprintf("SRElite2 mapimage: no value at "sigl)
foo=sre_command('STRING no value at line 'sigl)
return foo

oof2:
call pmprintf("SRElite2 mapimage: error 'rc ' at "sigl)
foo=sre_command('STRING Syntax error 'rc'  at 'sigl)
return foo
