/*
 * Copyright 2004 Richard A DeVenezia
 * Generate a graph of tables and key linkages
 * 5/13/04
 *
 * Inspired by Schemaball by Martin Krzywinski
 * http://mkweb.bcgsc.ca/schemaball
 *
 * Try a random schema:
 * http://www.devenezia.com/downloads/sas/samples#randomschema
 */

options ls=128;

%macro texup(degrees=);
  %local theta;
  %let theta = &degrees;

  if mod(&theta, 180)=90 then do;

    if mod(&theta,270) = 0
      then xup = +1.0;
      else xup = -1.0;

    rc = gset('texup', xup, 0.0);

  end;
  else do;

    if &theta < 0 then
      &theta = 360 - mod(-&theta,360);
    else
    if &theta >= 360 then
      &theta = mod(&theta,360);

    yup = 1;

    %* adjust y vector for 2nd and 3rd quadrants ;

    if &theta > 90 and &theta < 270
      then yup = -1.0;
      else yup = +1.0;

    %local degreesToRadians;

    %let degreesToRadians = 1.7453292519943300e-002;  /* 2pi/360 */

    %* adjust x vector per quadrant;
    if 180 < &theta <= 270 then
      xup = - tan ( - &theta * &degreesToRadians );
    else
    if 90 < &theta <= 180 then
      xup = + tan ( + &theta * &degreesToRadians );
    else
      xup = + tan ( - &theta * &degreesToRadians );

/*  */
    rc = gset('texup', xup, yup);

  end;
%mend texup;


%macro schemaBall
(
  libname=
, names=yes
, connect=bezier                       /* bezier | straight */
, show_match=                          /* perl regexs */
, hide_match=                          /* perl regexs */
, hide_render=remove                   /* remove | invisible */
, link_to_hidden=no                    /* no | yes */ /* yes only applicable if hide_render=invisible */
, highlight=                           /* perl regexs */
, hotspot=no                           /* no | yes */
, outpath=
, outfile=
, imgtype=png                          /* png | gif | jpg */
, pixels=1200
, ball_radius   = .8                   /* size of circle on which table nodes are placed */
, table_radius  = .02                  /* size of table nodes */
, bez_radius    = 1                    /* fraction of ball radius, circle on which control points lie */
, background    = d7e0f0
, textcolor     = 000000
, linkcolor     = cbd3e2
, linkcolor_hi  = 79a3ed
, linkcolor_fk  = 666666
, link_width    = 2
, link_width_hi = 3
, htext = 0.04
,
);

  proc sql;
    create table d1 as
    select * from DICTIONARY.TABLES
    where libname = "%upcase(&libname)"
    ;
  quit;

  proc datasets nolist lib=work;
    %if %sysfunc(exist(work.d2)) %then %do;
    delete d2 / mt=data;
    %end;
    contents noprint data=&libname.._ALL_
      out2=work.d2(keep=member name type ref where=(type='Foreign Key')) ;
  quit;

  %local dpi pixelcount inch size dev device outfile;

  %let dpi = 95;
  %let pixelcount = 1500;
  %let inch = %sysfunc (round (%sysevalf (&pixelcount/&dpi), .01));
  %let size = %sysfunc (round (%sysevalf (&pixels    /&dpi), .01));

  %let dev = &imgtype;
  %let device = big&dev;

  libname gdevice0 "%sysfunc(pathname(WORK))";
  proc gdevice catalog=gdevice0.devices nofs;
    %if %sysfunc(cexist(GDEVICE0.DEVICES.&device..DEV)) %then %do;
    delete &device;
    %end;
    copy &dev from=sashelp.devices newname=&device;
    modify &device xmax=&inch.in xpixels=&pixelcount ymax=&inch.in ypixels=&pixelcount;
  run;

  * Create the image using DSGI functions;

  ods listing;

  %if %length(&outfile) = 0 %then
    %let outfile = &outpath.schemaball-&libname..&imgtype.;

  filename gout "&outfile";

  goptions reset=all target=&device gunit=in gsfname=gout device=&device goutmode=replace;
  goptions hsize=&size.in vsize=&size.in;
* goptions vpos=400 hpos=400;

  title;
  footnote;

  data _null_;
    rc = gset ('CATALOG', 'WORK', 'SCHEMABALL');

    rc = ginit();
    rc = graph('CLEAR', "&libname");

    f = &size/2;

*   rc = gset ('VIEWPORT', 1, 0,0, 1,1);
*   rc = gset ('WINDOW', 1, -pixels/2, -pixels/2, pixels/2, pixels/2);
    rc = gset ('WINDOW', 1, -f,-f, f,f);
    rc = gset ('TRANSNO', 1);

    rc = gdraw ('BAR',  -f,-f, f,f);

    rc = gset ('TEXFONT', '"Comic Sans MS"');
    rc = gset ('TEXFONT', '"Arial"');
    rc = gset ('TEXFONT', 'SwissX');
    rc = gset ('TEXFONT', ' ');

    rc = gset ('TEXHEIGHT', &htext);

    pi = constant ('PI');
    two_pi = 2 * pi;
    tr = &table_radius * f;

    declare hash h ();
    h.defineKey  ('memname');
    h.defineData ('memname', 'theta_radian');
    h.defineDone ();

    do table_num = 1 to ntables ;

      set d1 nobs=ntables point=table_num;

      frac = (table_num-1) / ntables ;

      theta_radian = two_pi * frac;
      theta_degree = round (360 * frac, 1e-6);

      h.replace();

      x = &ball_radius * cos (theta_radian) * f ;
      y = &ball_radius * sin (theta_radian) * f ;

      rc = gdraw ('ARC', x,y,tr,0,360);

      %texup (degrees=theta_degree);

      dtheta = -0.007;
      if 180 < theta_degree < 270 then
        dtheta = 2*dtheta;

      x = (&ball_radius + &table_radius*1.5) * cos (theta_radian+dtheta) * f ;
      y = (&ball_radius + &table_radius*1.5) * sin (theta_radian+dtheta) * f ;

      text = memname;
      rc = gdraw ('TEXT', x,y, text);
/*
      x = cos (theta_radian) * f ;
      y = sin (theta_radian) * f ;

      x0 = cos (theta_radian) * f/1.4 ;
      y0 = sin (theta_radian) * f/1.4 ;

      rc = gdraw ('LINE', 2, x0,x, y0,y);
*/
    end;

    inset_radius = 0.0 + 0.005;

    do fk_num = 1 to nfks;

      set d2 nobs=nfks point=fk_num;

      memname = member;
      h.find ();
      head_radian = theta_radian;

      memname = scan (ref, 2, '.');
      if memname = '' then memname = ref;
      h.find();
      tail_radian = theta_radian;

      xh = (&ball_radius - &table_radius - inset_radius) * cos (head_radian) * f ;
      yh = (&ball_radius - &table_radius - inset_radius) * sin (head_radian) * f ;

      xt = (&ball_radius - &table_radius - inset_radius) * cos (tail_radian) * f ;
      yt = (&ball_radius - &table_radius - inset_radius) * sin (tail_radian) * f ;


      %if &connect = straight %then %do;
        rc = gdraw ('LINE', 2, xt,xh, yt,yh);
      %end;
      %else %do;
        _x0 = xt;
        _y0 = yt;
        _x3 = xh;
        _y3 = yh;
        link drawBez;
      %end;

    end;

    rc = graph('UPDATE');*,'NOSHOW');
    rc = gterm();
    stop;

drawBez:
    array _x[0:3] _x0-_x3;
    array _y[0:3] _y0-_y3;

    _x1 = 0;
    _y1 = 0;
    _x2 = _x1;
    _y2 = _y1;

    _x1 = (_x0 + _x3) / 2;
    _y1 = (_y0 + _y3) / 2;

    fr = &bez_radius;

    _x1 = fr * _x1;
    _y1 = fr * _y1;

    _x2 = _x1;
    _y2 = _y1;

    cx = 3 * (_x(1) - _x(0));
    bx = 3 * (_x(2) - _x(1)) - cx;
    ax = _x(3) - _x(0) - cx - bx;

    cy = 3 * (_y(1) - _y(0));
    by = 3 * (_y(2) - _y(1)) - cy;
    ay = _y(3) - _y(0) - cy - by;

    xtp = _x(0);
    ytp = _y(0);

    iterations = 20;

    do t = 0 to 1 by 1/iterations;

      xt = ax * t ** 3 + bx * t ** 2 + cx * t + _x(0);
      yt = ay * t ** 3 + by * t ** 2 + cy * t + _y(0);

  *   rc = gdraw('LINE', 2, xtp,xtp, ytp,ytp);
      rc = gdraw('LINE', 2, xtp,xt , ytp,yt );

      xtp = xt;
      ytp = yt;
    end;
return;

  run;

%EndMacro:
%mend;

/**/

options mprint;

libname foo "c:\temp\random\schemas\foo";

%let outpath = \\extreme\samples\;

/*
%schemaBall (libname=foo, pixels=300, ball_radius=0.8, connect=straight, outpath=&outpath);
%schemaBall (libname=foo, pixels=1000, ball_radius=0.8, connect=bezier, htext=.1, bez_radius=.5, outpath=&outpath);
*/

%schemaBall (libname=foo, pixels=300, ball_radius=0.8, connect=bezier, htext=.04, bez_radius=.5, outpath=&outpath);

/**/