home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Spezial / SPEZIAL2_97.zip / SPEZIAL2_97.iso / ANWEND / ONLINE / SREFPRC1 / MAPIMAGE.SRF < prev    next >
Text File  |  1997-07-06  |  18KB  |  480 lines
  1. /* ------------------- Mappable images processor -----------------------------*/
  2. /*  SREFILTR's  "mappable" images processor.
  3. .
  4. .   The bulk of this (the READMAP, GetURLfromMAP, and CrossingsMultiplyTest)
  5. .   was taken pretty much verbatim from the GOHTTP package:
  6. .       "GoHTTP REXX Filter Script for GoServe v2.00+ for OS/2
  7. .        by Donald L. Meyer
  8. .
  9. .    A NSCA or CERN style MAP file is expected, which should contain
  10. .    instructions as to what regions of the image map to
  11. .    what urls.  Four types of regions are recognized:
  12. .       rectangles, polygons, points.
  13.     If the selected point falls within a circle, rectangle, or polygon,
  14. .    or it's exactly on a point, then we have a direct match.  If this doesn't
  15. .    occur, and there are points selected, then it is assigned to the closest point,
  16. .    given that the distance to this closest point is less then max_pointdist (in pixel)
  17. .    If none of these satisfied, then use default_url.
  18.  
  19.  
  20. Ncsa style map:
  21. rect recthead.1 109,10 183,68 
  22. circle shoucirc.1 75,103 112,122 
  23. poly poly.1  57,191 47,187 41,189 41,189 38,191 38,191 38,192
  24. default defa.1
  25.  
  26. cern style map:
  27. rect (109,10) (183,68) recthead.1
  28. circle (75,103) 41 shoucirc.1
  29. poly  (62,190) (57,191) (47,187) (41,189) (41,189) (38,191) (38,191) (38,192) poly.1
  30. default defa.1
  31.  
  32.  
  33. */
  34. /* -------------------------------------------------------------*/
  35.  
  36. /* ----------------------------------------------------------------------- */
  37. /*  Main routine for processing mappable images respones */
  38. /* ----------------------------------------------------------------------- */
  39.  
  40. sref_mapimage:
  41.  
  42. parse arg  mapfile,awords, servername, serverport, tempfile, dir, max_pointdist,verbose,seluse,maptype
  43.  
  44.     maptype=upper(strip(maptype))
  45.     if wordpos(maptype,'CERN NCSA')=0 then maptype='NCSA'
  46.  
  47.       awords=packur(awords)
  48.  
  49.       default_url=""
  50.  
  51.       parse var awords ax ',' ay  .
  52.       parse var ay ay '?' .             /* get rid of accidentally added junk*/
  53.  
  54.       if datatype(ax)<>"NUM" | datatype(ay)<>"NUM" then signal noxy
  55.       if datatype(max_pointdist)<>"NUM" then max_pointdist=50
  56.  
  57. /* check for mapfile, or mapfile.map */
  58.       aa=stream(mapfile,'c','query exists')
  59.       if aa="" & pos('.',mapfile)=0 then do   /* add .map if non existent map file and no . */
  60.             mapfile=mapfile'.MAP'
  61.        end
  62.       ause=sref_fileread(mapfile,'filelines',,'E')
  63.       doit=filelines.0
  64.  
  65.       if doit=0 then signal nomap      /* no such map file */
  66.  
  67.  
  68.      bbpath=filespec('p',seluse)
  69.  
  70.       region.0=0
  71.       nr2=readmap()   /* sets default_url and Region,
  72.                          expects filelines. servername port */
  73.  
  74.       if nr2=0 & default_url="" then signal nourl
  75.           if VERBOSE>1 then call pmprintf_sref(" Using mapfile: " mapfile " , # regions=" region.nregions)
  76.  
  77.       message=geturlfrommap(ax, ay)
  78.  
  79.       if message="" then signal nomatch   /* could not find a url */
  80.  
  81. /* add base url path (from the mapimage/xxx/foo.map request string)
  82.    if needed */
  83.       poo=strip(translate(upper(message),'/','\'))
  84.       select
  85.         when pos('/',poo)=0 then        /* no /, must be in mapfile directory */
  86.              message=bbpath||message
  87.         when pos('HTTP://',poo)>0 | abbrev(poo,'/')=1 then
  88.                 nop
  89.         when pos('.',poo)> pos('/',poo) then
  90.                 message=bbpath||message
  91.         otherwise
  92.            nop
  93.       end
  94.       
  95.       message=sref_fix_url(message,servername,serverport)
  96.  
  97. /* we send back to the server a "redirect to this found url" response */
  98.     if VERBOSE>0 then  call pmprintf_sref(" Moved to Url: " message)
  99.  
  100.  /* Send back resonse headers */
  101.      'RESPONSE HTTP/1.0 302 Moved Temporarily'    /* Set HTTP response line */
  102.      'HEADER ADD URI: 'message
  103.      'HEADER ADD Location: 'message
  104.      doc = '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  105.  
  106.       'VAR TYPE text/html BINARY NAME doc'
  107.       return 1
  108.      if VERBOSE>0 then call pmprintf_sref(" Redirect to " message)
  109.  
  110.  
  111.   /* error returns ... */
  112. nourl:                  /* jump here if no such url found */
  113.    call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  114.  
  115.   call lineout tempfile, "<html><head><title> No such matching URL </title>"
  116.   call lineout tempfile, "</head>"
  117.   call lineout tempfile, "<body><h2>Could not find any URLS.</h2>"
  118.   call lineout tempfile, ' No URLS were listed in the "map" file ' mapfile0
  119.   call lineout tempfile, ' </body> </html> '
  120.   if VERBOSE>0 then call pmprintf_sref(" Empty mapfile: " mapfile)
  121.   'FILE ERASE TYPE text/html NAME '||tempfile
  122.    return 0
  123.  
  124.  
  125. nomatch:                  /* jump here if no url found */
  126.    call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  127.  
  128.   call lineout tempfile, "<html><head><title> No  URL selected </title>"
  129.   call lineout tempfile, "</head>"
  130.   call lineout tempfile, "<body><h2>A URL was not selected</h2>"
  131.   call lineout tempfile, ' You selected a region NOT associated with a URL: ' ax ay
  132.   call lineout tempfile, ' </body> </html> '
  133.   if VERBOSE>0 then call pmprintf_sref(' No URL match: ' ax' ' ay' ' mapfile)
  134.   'FILE ERASE TYPE text/html NAME 'tempfile
  135.   return 0
  136.  
  137. nomap:
  138.    call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  139.  
  140.   call lineout tempfile, "<html><head><title> No such MAP file </title>"
  141.   call lineout tempfile, "</head>"
  142.   call lineout tempfile, "<body><h2>Could not find MAP file.</h2>"
  143.   call lineout tempfile, ' The "map" file ' mapfile0 ' could not be found.'
  144.   call lineout tempfile, ' </body> </html> '
  145.   if VERBOSE>0 then call pmprintF_sref(' No such mapfile: ' mapfile)
  146.   'FILE ERASE TYPE text/html NAME 'tempfile
  147.   return 0
  148.  
  149. noxy:                           /* invalid x y */
  150.    call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  151.  
  152.   call lineout tempfile, "<html><head><title> Bad location </title>"
  153.   call lineout tempfile, "</head>"
  154.   call lineout tempfile, "<body><h2>Invalid pixel location given.</h2>"
  155.   call lineout tempfile, ' The location given is invalid:' ax " , " ay
  156.   call lineout tempfile, ' </body> </html> '
  157.   if VERBOSE>0 then call pmmprintf_sref(' Bad x y: ' ax' ' ay)
  158.   'FILE ERASE TYPE text/html NAME 'tempfile
  159.   return 0
  160.  
  161.  
  162.  
  163.  
  164.  
  165. /* ----------------------------------------------------------------------- */
  166. /* READMAP: Read in the .MAP file into a stem variable.
  167. .    The stem variable Region. gets filled up with "region" info.
  168. .    Also, the default_url gets set (if a DEFAULT line is found)           */
  169. /* ----------------------------------------------------------------------- */
  170.  
  171. readMap: procedure expose Region. Default_URL filelines.  ServerName Port verbose maptype
  172.  
  173.  
  174.         /* Initilizations */
  175.    i = 0
  176.    nR = 0
  177.    strongchecks=1               /* always check for proper syntax */
  178.    Text = '%'
  179.    Default_URL = ''
  180.  
  181. /* read file into filelines. array */
  182.  
  183.  
  184.         /* read in the region definitions from the .MAP file.  */
  185.    do jj=1 to filelines.0
  186.      text=strip(filelines.jj)
  187.      if text="" then iterate            /* ignore blank lines */
  188.      if  left(Text,1)= '#' then iterate  /* # starts a comment line */
  189.  
  190.      i = i + 1
  191.  
  192.      parse var Text Text '#' comments   /* trim any comments   */
  193.      r = right(Text,1)
  194.      l = left(comments,1)
  195.      if (((r \= ' ') & (r \= '') & (r \= '09'x)) & ((l \= ' ') & (l \= '') & (l \= '09'x))) then do
  196.         parse var comments comments'#'rest      /* trim any comments, again   */
  197.         Text = Text'#'comments
  198.      end
  199.  
  200.  
  201. /* a hack to deal with cern maps */
  202.     if maptype="CERN" then do
  203.        atext=translate(text,' ','()')
  204.        if words(text)> 2 then do        /* if 2, same syntax */
  205.            nw=words(text)
  206.            t1=word(text,1); t3=word(text,nw)
  207.            if upper(t1)="CIRCLE" then t1="CIRC"
  208.            t2=translate(subword(text,2,nw-2),' ','()')
  209.            text=t1||' '||t3||' '||t2
  210.         end
  211.      end
  212.      parse var Text T  Region.URL.i  Cs
  213.      parse var Cs C1 C2
  214.      parse upper var T Region.Type.i
  215.  
  216.      parse var Text T  Region.URL.i  Cs
  217.      parse var Cs C1 C2
  218.      parse upper var T Region.Type.i
  219.  
  220.  
  221.  
  222.      Err = 0
  223.      Select
  224.  
  225.  
  226.         /* DEFAULT keyword sets the default URL to redirect to in case of no region matches. */
  227.        When (Region.Type.i = 'DEFAULT') then do
  228.            Default_URL = Region.URL.i
  229.            i = i - 1
  230.          end
  231.  
  232.         /* Parse out coordinates for the Rectangular region.  */
  233.        When (Region.Type.i = 'RECT') then do
  234.            parse var C1 Region.X1.i ',' Region.Y1.i
  235.            parse var C2 Region.X2.i ',' Region.Y2.i
  236.            if (StrongChecks) then do
  237.               if ((Datatype(Region.X1.i) \= 'NUM') | (Datatype(Region.Y1.i) \= 'NUM') | (Datatype(Region.X2.i) \= 'NUM') | (Datatype(Region.Y2.i) \= 'NUM')) then Err = 1
  238.            end
  239.  
  240.            if (Err == 0) then do
  241.               nR = nR + 1
  242.         /* ensure that X1,Y1 is upper left, and X2,Y2 is lower right... */
  243.               if (Region.X2.i < Region.X1.i) then       /* Swap... */
  244.                do 1
  245.                  a = Region.X2.i
  246.                  Region.X2.i = Region.X1.i
  247.                  Region.X1.i = a
  248.                end
  249.               if (Region.Y2.i < Region.Y1.i) then       /* Swap... */
  250.                do
  251.                  a = Region.Y2.i
  252.                  Region.Y2.i = Region.Y1.i
  253.                  Region.Y1.i = a
  254.                end
  255.             end
  256.          end
  257.  
  258.         /* Parse out coordinates for the Circle region.  */
  259.        When (Region.Type.i = 'CIRC') then do
  260.            parse var C1 Region.X1.i ',' Region.Y1.i
  261.                 /* radius... */
  262.            Region.X2.i = C2
  263.            if (StrongChecks) then do
  264.               if ((Datatype(Region.X1.i) \= 'NUM') | (Datatype(Region.Y1.i) \= 'NUM') | (Datatype(Region.X2.i) \= 'NUM')) then Err = 1
  265.            end
  266.            if (Err == 0) then do
  267.               Region.radius2.i = (Region.X2.i**2)
  268.               nR = nR + 1
  269.            end
  270.          end
  271.  
  272.         /* Parse out coordinates for the Circle region.  */
  273.        When (Region.Type.i = 'CIRCLE') then do
  274.            parse var C1 Region.X1.i ',' Region.Y1.i
  275.            parse var C2 Region.X2.i ',' Region.Y2.i
  276.  
  277.            if (StrongChecks) then do
  278.               if ((Datatype(Region.X1.i) \= 'NUM') | (Datatype(Region.Y1.i) \= 'NUM') | (Datatype(Region.X2.i) \= 'NUM') | (Datatype(Region.Y2.i) \= 'NUM')) then Err = 1
  279.            end
  280.  
  281.            if (Err == 0) then do
  282.                 /* radius... */
  283.               qX = (Region.X1.i - Region.X2.i)
  284.               qY = (Region.Y1.i - Region.Y2.i)
  285.               Region.radius2.i = (qX*qX) + (qY*qY)
  286.               nR = nR + 1
  287.            end
  288.          end
  289.  
  290.         /* handle the Poly region.  */
  291.        When (Region.Type.i = 'POLY') then do
  292.            k=1
  293.            do while (strip(Cs) \= '') & (Err == 0)
  294.               parse var Cs Region.X.i.k ',' Region.Y.i.k Cs
  295.               if (StrongChecks) then if ((Datatype(Region.X.i.k) \= 'NUM') | (Datatype(Region.Y.i.k) \= 'NUM')) then Err = 1
  296.               k = k + 1
  297.            end
  298.  
  299.            if (Err == 0) then do
  300.               Region.NVerts.i = (k - 1)
  301.               Region.X.i.k = -1
  302.               nR = nR + 1
  303.            end
  304.  
  305.          end
  306.  
  307.         /* handle the Point region.  */
  308.        When (Region.Type.i = 'POINT') then do
  309.            parse var C1 Region.X1.i ',' Region.Y1.i
  310.            if (StrongChecks) then do
  311.               if ((Datatype(Region.X1.i) \= 'NUM') | (Datatype(Region.Y1.i) \= 'NUM')) then Err = 1
  312.            end
  313.            if (Err == 0) then nR = nR + 1
  314.          end
  315.  
  316.         /* handle the standard blank line between 'Default' line and other regions... */
  317.        When (Region.Type.i = '') then do
  318.            if ((i = 1) & (Default_URL \= '')) then do
  319.               Text = '%'
  320.               i = i - 1
  321.             end
  322.          end
  323.  
  324.         /* Must be an unknown region type... */
  325.        Otherwise do
  326.            if (Text \= '') then
  327.               if VERBOSE>0 then call pmprintf_sref('Unknown RegionType=['Region.Type.i']  URL=<'Region.URL.i'>  [C1='C1'  C2='C2']')
  328.            i = i - 1
  329.          end
  330.      end /* Select */
  331.      if (Err == 1) then 
  332.          if VERBOSE>0 then call pmprintf_sref('error:  region #'i)
  333.      if (Err == 1) then i = i - 1
  334.    end
  335.    rc = stream(Map.filename.ID, 'C', 'CLOSE')
  336.    Region.NRegions = nR
  337.    return nR
  338.  
  339.  
  340. /* ----------------------------------------------------------------------- */
  341. /* GetURLfromMap: Identify the region of the map, & return the associated URL */
  342. /* ----------------------------------------------------------------------- */
  343.  
  344. GetURLfromMap: procedure expose Region. Default_URL max_pointdist verbose
  345.  
  346.         /* Parse out mouse click coordinates */
  347.    parse arg tX , tY
  348.  
  349.    i = 1;   Hit = 0;  sawpoint = 0
  350.  
  351.         /* Set URL to the default, in case no regions are hit... */
  352.    _URL = Default_URL
  353.  
  354.         /* if tX & tY = '', then assume web client not imagemap capable - bypass region search. */
  355.    if (tX='') then Hit = -1
  356.  
  357.  
  358.         /* Loop through the defined regions to find first hit. */
  359.    do while ((i <= Region.NRegions) & (Hit = 0))
  360.      Select
  361.  
  362.         /* Determine if coordinates lie within the rectangular area.  */
  363.        When Region.Type.i = 'RECT' then do
  364.           Hit = ((tX >= Region.X1.i) & (tY >= Region.Y1.i) & (tX <= Region.X2.i) & (tY <= Region.Y2.i))
  365.         end
  366.  
  367.         /* Calc distance to coordinates from Circle center, and compare to radius.*/
  368.         /*   If less than radius, then it's a hit... */
  369.        When (Region.Type.i = 'CIRC') | (Region.Type.i = 'CIRCLE') then do
  370.           a = tX - Region.X1.i
  371.           b = tY - Region.Y1.i
  372.           R = a**2 + b**2
  373.           Hit = (R <= Region.radius2.i)
  374.         end
  375.  
  376.         /* Determine if coordinates lie within the polygon.  */
  377.        When Region.Type.i = 'POLY' then do
  378.            Hit = CrossingsMultiplyTest(i, tX, tY)
  379.         end
  380.  
  381.        When Region.Type.i = 'POINT' then do
  382.           a = tX - Region.X1.i
  383.           b = tY - Region.Y1.i
  384.           R = (a * a) + (b * b)
  385.         /* If a direct hit, then don't bother with nearest determinations... */
  386.           if (R == 0) then Hit = 1
  387.         /* otherwise, track to find which point is nearest the click coordinates... */
  388.           else if (sawpoint) then do
  389.              if (R < PointDistance) then do
  390.                 PointDistance = R
  391.                 ClosestPoint = i
  392.              end
  393.           end
  394.           else do
  395.              sawpoint = 1
  396.              PointDistance = R
  397.              ClosestPoint = i
  398.           end
  399.         end
  400.  
  401.  
  402.         /* The required 'Otherwise'... */
  403.        Otherwise  do
  404.         end
  405.      End /* Select */
  406.  
  407.         /* If a hit, then set '_URL' to stem URL value.  */
  408.      if (Hit = 1) then do
  409.            _URL = Region.URL.i
  410.      end
  411.      i = i + 1
  412.    end
  413.  
  414.    if (Hit == 0) & (sawpoint) & (pointdistance < (max_pointdist*max_pointdist)) then do
  415.       _URL = Region.URL.ClosestPoint
  416.    end
  417.  
  418.    return _URL          /* return the identified URL */
  419.  
  420. /* ----------------------------------------------------------------------- */
  421. /* ======= Crossings Multiply algorithm ===================================
  422. .    point in polygon inside/outside code.
  423. .  Original C code by Eric Haines, 3D/Eye Inc, erich@eye.com
  424. .  based on work by Joseph Samosky and Mark Haigh-Hutchinson.
  425. .  Ported to REXX for this filter by D.L. Meyer, meyer@larch.ag.uiuc.edu
  426. */
  427. /* ----------------------------------------------------------------------- */
  428.  
  429. CrossingsMultiplyTest: Procedure expose Region. verbose
  430.     parse arg pgon, pointX, pointY
  431.  
  432.     numverts = Region.NVerts.pgon
  433.     vtx0X = Region.X.pgon.numverts
  434.     vtx0Y = Region.Y.pgon.numverts
  435.     /* get test bit for above/below X axis */
  436.     yflag0 = ( vtx0Y >= pointY )
  437.  
  438.     inside_flag = 0
  439.     do j = 1 to numverts
  440.               vtx1X = Region.X.pgon.j
  441.               vtx1Y = Region.Y.pgon.j
  442.  
  443.         yflag1 = ( vtx1Y >= pointY )
  444.         /* Check if endpoints straddle (are on opposite sides) of X axis
  445.          * (i.e. the Y's differ); if so, +X ray could intersect this edge.
  446.          * The old test also checked whether the endpoints are both to the
  447.          * right or to the left of the test point.  However, given the faster
  448.          * intersection point computation used below, this test was found to
  449.          * be a break-even proposition for most polygons and a loser for
  450.          * triangles (where 50% or more of the edges which survive this test
  451.          * will cross quadrants and so have to have the X intersection computed
  452.          * anyway).  I credit Joseph Samosky with inspiring me to try dropping
  453.          * the "both left or both right" part of my code.
  454.          */
  455.         if ( yflag0 \= yflag1 ) then do
  456.             /* Check intersection of pgon segment with +X ray.
  457.              * Note if >= point's X; if so, the ray hits it.
  458.              * The division operation is avoided for the ">=" test by checking
  459.              * the sign of the first vertex wrto the test point; idea inspired
  460.              * by Joseph Samosky's and Mark Haigh-Hutchinson's different
  461.              * polygon inclusion tests.
  462.              */
  463.             if ( (((vtx1Y-pointY) * (vtx0X-vtx1X)) >= ((vtx1X-pointX) * (vtx0Y-vtx1Y))) == yflag1 ) then do
  464.                 inside_flag = (inside_flag  == 0)
  465.             end
  466.         end
  467.  
  468.         /* Move to the next pair of vertices, retaining info as possible. */
  469.         yflag0 = yflag1
  470.         vtx0X = vtx1X
  471.         vtx0Y = vtx1Y
  472.  
  473.     end
  474.  
  475.     return  inside_flag
  476.  
  477.  
  478.  
  479.  
  480.