*
;

 /**********************************************************************
 *  Copyright(c) 1995 by SAS Institute Inc., Cary, NC USA
 *   MODULE:    ismap.sas
 *   PRODUCT:   None.  This is a sample program.
 *   VERSION:   6.11
 *   AUTHOR:    Michael Burns
 *   DATE:      23MAR95
 *   DESC:      A SAS program to generate input sensitive maps using
 *              SAS proc GMAP. If you have a maps dataset and this SAS 
 *              program, you can make nice Web pages with that map and   
 *              have each object in the map be a clickable link.
 ***********************************************************************/

%macro ismap(DS,       /* dataset to be mapped */
             IDVAR,    /* variable that id's segments */
             IDTYPE,   /* type of IDVAR, 'C' for character, 'N' for numeric */
             RESPVAR,  /* response variable */
             IMGPATH,  /* pathname of image file to build */
             MAPPATH,  /* pathname of ismap file to build */
             XPIXELS,  /* horiz size of gif file created */
             YPIXELS,  /* vert size of gif file created */
             XMARGIN,  /* horiz coord of upper left corner of rect */
             YMARGIN,  /* vert coord of upper left corner of rect */
             DEFURL,   /* default url */
             BASEURL,  /* prefix for urls to be output */
             URLEXPR   /* variable or expression to complete url */
            );

proc sort data=&DS out=work.ismap1;
  by &IDVAR segment;
run;
proc means data=work.ismap1;
 var x y;
 output out=work.ismapbox;
run;
proc print data=work.ismapbox;
run;
data work.ismapmap;
 set work.ismapbox (rename=(x=boxx y=boxy));
 length &IDVAR 4
        segment 4
        x 5
        y 5
        ;
retain minx miny maxx maxy;
keep &IDVAR segment x y;
 if _stat_ = 'MIN' then
      do;
         minx = boxx;
         miny = boxy;
      end;
 if _stat_ = 'MAX' then
      do;
         maxx = boxx;
         maxy = boxy;
         /* calc size of box 0.5% of final picture */
         itsyx = (maxx - minx) / 200;
         itsyy = (maxy - miny) / 200;
         if 0 then
           do;  /* put out box around entire map */
              &IDVAR = _BLANK_;
              segment = 1;
              x = minx; y = maxy; output;
              x = maxx; y = maxy; output;
              x = maxx; y = miny; output;
              x = minx; y = miny; output;
           end;
         call symput('boxminx',minx);
         call symput('boxmaxx',maxx);
         call symput('boxminy',miny);
         call symput('boxmaxy',maxy);
         /* put out a little box in upper left */
         &IDVAR = _BLANK_;
         segment = 1;
         x = minx;       y = maxy; output;
         x = minx+itsyx; y = maxy; output;
         x = minx+itsyx; y = maxy-itsyy; output;
         x = minx;       y = maxy-itsyy; output;
         /* put out a little box in lower right */
         &IDVAR = _BLANK_;
         segment = 1;
         x = maxx;       y = miny; output;
         x = maxx-itsyx; y = miny; output;
         x = maxx-itsyx; y = miny+itsyy; output;
         x = maxx;       y = miny+itsyy; output;
      end;
run;
proc append base=work.ismap1 new=work.ismapmap force;
run;
proc sort data=work.ismap1;
  by &IDVAR segment;
run;
proc greduce data=work.ismap1 out=work.ismap2
      n1=20 n2=40 n3=60 n4=80 n5=100;
     id &IDVAR;
run;
data _null_;
  length tag $120;
  length point $20;
  length numpairs 8; retain numpairs;
  set work.ismap2(where=(density<4));
  by &IDVAR segment;
  oldax = &boxminx;
  olday = &boxmaxy;
  oldbx = &boxmaxx;
  oldby = &boxminy;
  oldxrng = oldbx - oldax;
  oldyrng = oldby - olday;
  newax = &XMARGIN;
  neway = &YMARGIN;
  newbx = &XPIXELS - &XMARGIN;
  newby = &YPIXELS - &YMARGIN;
  newxrng = newbx - newax;
  newyrng = newby - neway;
  xscale = newxrng / oldxrng;
  yscale = newyrng / oldyrng;

  file &MAPPATH recfm=N;

  if _n_ = 1 then
    put 'default ' &DEFURL '0a'x;

    do;
        if first.segment then
          do;
             if &IDVAR = _BLANK_ then put '#';
             tag =  &BASEURL || &URLEXPR || '.html';
             put 'poly ' tag ;
             numpairs = 0;
          end;

        x = int(((x - oldax) * xscale)  + newax);
        y = int(((y - olday) * yscale)  + neway);
        point = trim(put(x,best.)) || ',' || left(put(y,best.));
        put point;
        ** put x ',' y ' ';
        numpairs + 1;
        if last.segment /* or numpairs > 5 */ then
           do;
            put '0a'x;
            numpairs = 0;
           end;
    end;

run;
pattern1 value=solid color=yellow;
pattern2 value=solid color=cyan;
pattern3 value=solid color=green;
pattern4 value=solid color=red;
pattern5 value=solid color=blue;
pattern6 value=solid color=magenta;
pattern7 value=solid color=pink;
pattern8 value=solid color=white;
pattern9 value=solid color=orange;
goptions noborder cback=grayBE;
x "rm -f %unquote(&IMGPATH)";
goptions dev=imggif gaccess="sasgastd>%unquote(&IMGPATH)";
proc gmap data=work.ismap1
          map=work.ismap1
          all;
   id &IDVAR;
   choro &RESPVAR/ nolegend coutline=black;
   ;
run;
quit;
%mend ismap;

*
;