/* Richard A. DeVenezia, 11/28/2002
 * http://www.devenezia.com
 *
 * Show samples of SAS and TrueType fonts
 * In annotate, font size unit is cells. Adjust hpos or vpos to change cell size.
 *
 * mod
 * 3/2/04 rad add codeFont= and size=
 * 2/1/05 rad parameterize with ncol and nrow
 * 2/6/05 rad dump true type fonts based on registry key Panose
 */

goptions reset=all;

%let stylen = %sysevalf ((&sysver > 6.12)*32 + 8);

/*
 * View for supplying annotation data
 * Note: It is doubly dynamic since fonts and sizes are
 *       obtained via a macro variable
 */
data anno / view=anno;
  length function $8 style $&stylen text $40 ;

  retain xsys ysys '1' function "label" position '+';

  codeFont = symget ('codeFont');
  textFont = symget ('font');
  textSize = input(symget ('size'),best12.);

  * name of the font at top middle ;
  x = 50;
  y = 98;
  style = codeFont;
  text = textFont;
  output;

  * layout each character;
  * label with ascii code (decimal and hex) and draw glyph of character;

  ncol = 8;
  nrow = 256/ncol;

  do i = 0 to 255;
    x = 100/ncol/2 + 100/ncol * floor (i/nrow) ;

    y = mod (i,nrow) / (nrow-1) ;
    y = 5 + 88 * (1-y);

    x = x - 3;
    text = left (put(i,3.));
    style = codeFont;
    size = .;
    output;

    x = x + 2;
    text = put (i,hex2.)||'x';
    output;

    x = x + 3;
    text = byte(i);
    style = textFont;
    size  = textSize;
    output;
  end;
  stop;
run;

/*
 * Here is the macro. Not much to look at.
 */

%macro gFont (font=, size=1, codeFont='Arial');
  proc gslide anno=anno border; run; quit;
%mend;


/** /

* examples;

* SAS fonts are not quoted;

%gFont (font=Special)
%gFont (font=Marker)
%gFont (font=SwissL)

* System fonts (TrueType or OpenType) are quoted;

%gFont (font='Arial', size=1.5)
%gFont (font='Arial/Bold', size=1.5)
%gFont (font='Comic Sans MS', size=1.5)

/**/


/** /

* dump all SAS fonts;

proc sql;
  create view sasfonts as
  select objname as font
  from dictionary.catalogs
  where memname = 'FONTS'
    and libname = 'SASHELP'
    and objtype = 'FONT'
    and objname not like 'HW%'
  ;
quit;

data _null_;
  set sasfonts;
  statement = cats('%nrstr(%gFont(font=''',font,''', size=1.5);)');
  put statement=;
  call execute (statement);
run;
/**/


/** /

* dump all TrueType fonts of a Windows machine;

* 1. create script to get font names from registry
*    and write them to standard out;

%let vbs = %sysfunc(pathname(WORK))\fontlist.vbs;

filename vbs "&vbs";

data _null_;
  file vbs;
  input;
  put _infile_;
cards4;
'List font names
'Richard A. DeVenezia - 5feb05

HKLM = &H80000002 'HKEY_LOCAL_MACHINE

set objRegistry = GetObject("winmgmts://./root/default:StdRegProv")

key = "SOFTWARE\Microsoft\Shared Tools\Panose"
If 0 = objRegistry.EnumValues(HKLM, key, values) Then
  For Each value In values
    WScript.Stdout.WriteLine value
  Next
End If

key = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Type 1 Installer\Type 1 Fonts\"
If 0 = objRegistry.EnumValues(HKLM, key, values) Then
  For Each value In values
    WScript.Stdout.WriteLine value
  Next
End If

;;;;

* 2. read font names into a table;

filename fontlist pipe "cscript/b &vbs";

data fonts;
  infile fontlist;
  input;
  length font $100;
  font = _infile_;
  if font ne '';
run;

proc sort data=fonts;
  by font;
run;

* 3. invoke gFont with each font name;

data _null_;
  set fonts;

  statement = cats('%nrstr(%gFont(font=''',font,''', size=2.50);)');
  call execute (statement);
run;

/**/