/* This set of macros will read a Microsoft Theme file and convert it
 * to an ODS style.
 */

/* USAGE: 
 * 
 * %inc theme;
 * %thm2tpl(themedir/themename.theme, templatename);
 *
 * The style will now be available for use as follows:
 * 
 *    ods html style=styles.<templatename> ... ;
 *
 * Using the generic "theme" style on MSIE will match the desktop colors.
 *
 *    ods html style=styles.theme ... ;
 *
 * To import the code version of the generic theme style, do the following:
 *
 *    proc template;
 *      %inc "theme.tpl";
 *    run;
 *
 * To import the code version of the style (templatename.tpl), 
 * do the following:
 *
 *    proc template;
 *      %inc "<templatename>.tpl";
 *    run;
 *
 * See the examples at the bottom of this file for the usage of the
 * other macro options.
 *
 */

%macro getVars(input,output,themedir,snd,ico,bg);
%global maximize minimize menucommand menupopup systemquestion appgpfault
        systemasterisk systemexclamation systemstart background menutext
        menu activetitle foreground appworkspace hilight hilighttext note
        warn full empty watermark wallpaper titletext open close restoredown
        restoreup ringin ringout systemdefault systemexit systemhand
        emptyrecyclebin tilewallpaper;

  data _null_;
    length value $ 70;
    length current $ 70;
    length line $ 150;
    retain out 0;
    infile "&input" pad;
    input line $char150.;
    /*line = lowcase((trim(left(line))));*/
    line = trim(left(line));
    len=length(line);
    if substr(line,len,1) = '0d'x then substr(line,len,1) = '';

    /* Replace ThemeDir environment variable with correct path */
    pos = index(lowcase(line),'%themedir%');
    if pos > 0 then 
    do;
      value = substr(line,pos+10); 
      value = (trim(left(value)));
      substr(line,pos) = ''; 
      line = trim(line) || trim(&themedir) || value;
    end;

    /* Replace WinDor environment variable with correct path */
    pos = index(lowcase(line),'%windir%');
    if pos > 0 then 
    do;
      value = substr(line,pos+8); 
      value = (trim(left(value)));
      substr(line,pos) = ''; 
      line = trim(line) || trim(&themedir) || value;
    end;

    /* Change backslash path separators to forward slash */
    pos = index(line,'\');
    do while (pos > 0);
      value = substr(line,pos+1); 
      value = (trim(left(value)));
      substr(line,pos) = ''; 
      line = trim(line) || '/' || value;
      pos = index(line,'\');
    end;

    /* Change icon references to GIF or BMP */
    rx=rxparse(".ico?*$d*$w*@0");  
    retain rx;  
    drop rx;
    pos = rxmatch(rx,line);
    if pos > 0 then 
    do;
      substr(line,pos) = ''; 
      line = trim(line) || '.bmp';
    end;

    /* If a square bracket is reached, we need to check for special
     * parameters that will need to be cached since their values will
     * occur on a later line.
     */ 
    pos = index(line,'[');
    if pos > 0 then 
    do;
      current = '';
      if index(lowcase(line),'20d04fe0') > 0 then current = 'note';
      if index(lowcase(line),'208d2c60') > 0 then current = 'warn';
      if index(lowcase(line),'appgpfault/') > 0 then current = 'appgpfault';
      if index(lowcase(line),'maximize/') > 0 then current = 'maximize';
      if index(lowcase(line),'menucommand/') > 0 then current = 'menucommand';
      if index(lowcase(line),'menupopup/') > 0 then current = 'menupopup';
      if index(lowcase(line),'minimize/') > 0 then current = 'minimize';
      if index(lowcase(line),'open/') > 0 then current = 'open';
      if index(lowcase(line),'close/') > 0 then current = 'close';
      if index(lowcase(line),'restoredown/') > 0 then current = 'restoredown';
      if index(lowcase(line),'restoreup/') > 0 then current = 'restoreup';
      if index(lowcase(line),'ringin/') > 0 then current = 'ringin';
      if index(lowcase(line),'ringout/') > 0 then current = 'ringout';
      if index(lowcase(line),'systemasterisk/') > 0 then current = 'systemasterisk';
      if index(lowcase(line),'systemdefault/') > 0 then current = 'systemdefault';
      if index(lowcase(line),'systemexclamation/') > 0 then current ='systemexclamation';
      if index(lowcase(line),'systemexit/') > 0 then current = 'systemexit';
      if index(lowcase(line),'systemhand/') > 0 then current = 'systemhand';
      if index(lowcase(line),'systemquestion/') > 0 then current = 'systemquestion';
      if index(lowcase(line),'systemstart/') > 0 then current = 'systemstart';
      if index(lowcase(line),'emptyrecyclebin/') > 0 then current = 'emptyrecyclebin';
    end;
    retain current;

    pos = index(line,'=');
    if pos > 0 then do;
      if index(lowcase(line),'defaultvalue') = 1 then 
      do;
        param = lowcase(current);
        value = substr(line,pos+1); 
        value = (trim(left(value)));

        if &ico = 0 then do;
          if (param eq 'note' | param eq 'warn') then value = '%STR()';
        end;
        if &snd = 0 then do;
          if (param eq 'appgpfault'     | param eq 'maximize'          | 
              param eq 'menucommand'    | param eq 'menupopup'         | 
              param eq 'minimize'       | param eq 'open'              | 
              param eq 'close'          | param eq 'restoredown'       | 
              param eq 'restoreup'      | param eq 'ringin'            | 
              param eq 'ringout'        | param eq 'systemasterisk'    | 
              param eq 'systemdefault'  | param eq 'systemexclamation' | 
              param eq 'systemexit'     | param eq 'systemhand'        | 
              param eq 'systemquestion' | param eq 'systemstart'       | 
              param eq 'emptyrecyclebin' 
             ) 
             then value = '%STR()';
        end;
        if param ne '' and index(param,'.') = 0 then call symput(param,trim(value));
      end;
      else 
      do;
        /* The screen saver line will create an invalid macro name */
        if index(lowcase(line),'scrnsave.exe') = 0 then 
        do;
          param = line;
          value = substr(param,pos+1); 
          value = (trim(left(value)));
          substr(param,pos) = ''; 
          param = lowcase(param);
         
          /* Check for a string of 3 numbers.  These should be converted
           * to hexadecimal 
           */
          value = (trim(left(value)));
          rx=rxparse("$d+$w+$d+$w+$d+$w*@0");  
          retain rx;  
          drop rx;
          if rxmatch(rx,value) = 1 then 
          do;
            %getHex(value);

            /* Calculate the color of the foreground based on the 
             * background color just like it works on the Windows desktop
             */
            if param eq 'background' then 
            do;
              foreground = int(red) + int(green) + int(blue);
              if foreground > 384 then 
              do;
                call symput('foreground','000000');
              end;
              else
              do;
                call symput('foreground','FFFFFF');
              end;
            end;
            if param ne '' and index(param,'.') = 0 then call symput(param,trim(value));
          end;
          else 
          do;
            if &ico = 0 then do;
              if (param eq 'full' | param eq 'empty') then value = '%STR()';
            end;
            if param eq 'wallpaper' and &bg = 0 then value = '%STR()';
            if param eq 'tilewallpaper' then 
            do;
              param = 'watermark';
              if index(value,'0') > 0 then 
              do;
                value = '%STR(yes)';
              end;
              else
              do;
                value = '%STR(no)';
              end;
            end;
            if param ne '' and index(param,'.') = 0 then call symput(param,trim(value));
          end;
        end;
      end;
    end;
  run;
%mend;

%macro getHex(rgb);
  cpos = index(&rgb,' ');
  red = &rgb;
  if cpos > 0 then do;
    substr(red,cpos) = '';
    gb = substr(&rgb,cpos+1);
    cpos = index(gb,' ');
    if cpos > 0 then do;
      green = gb;
      substr(green,cpos) = '';
      blue = substr(gb,cpos+1);
    end;
  end;
  value = put(int(red),hex2.) || put(int(green),hex2.) || put(int(blue),hex2.);
%mend;

%macro thm2tpl(input,output,themedir='',snd=1,ico=1,bg=1);
/*
 * Create a template based on values in the theme file
 *
 * Required Arguments:
 * input - input theme file
 * output - output style name
 * 
 * Optional Arguments:
 * themedir - the directory where auxiliary files for the theme are
 *    kept.  Not all themes require this.  If your background image
 *    and audio files don't work, try setting this to their location.
 * snd - boolean indicating whether sound files from the theme should
 *    be used when loading the document, clicking the "Table of Contents"
 *    banner, and mousing over notes.
 * ico - boolean indicating whether icon files should be used in the
 *    note banners.  Icon files need to be converted to BMP files in
 *    order for this to work.
 * bg - boolean indicating whether or not the background image
 *    should be used.
 *
 */

  %getVars(&input,&output,&themedir,&snd,&ico,&bg);

  proc template;
  define style styles.&output; parent=styles.theme;

  replace fonts /
    "docFont" = ("'Lucida Grande', verdana, sans-serif", 2)
    "headingFont" = ("'Lucida Grande', verdana, sans-serif", 3, bold)
    "headingEmphasisFont" = ("'Lucida Grande', verdana, sans-serif", 3, italic bold)
    "FixedFont" = ("'courier new', courier, fixed", 3 )
    "FixedHeadingFont" = ("'courier new', courier, fixed", 3 )
    "FixedStrongFont" = ("'courier new', courier, fixed", 3, bold)
    "FixedEmphasisFont" = ("'courier new', courier, fixed", 2, italic)
    "EmphasisFont" = ("'Lucida Grande', verdana, sans-serif", 2, italic)
    "StrongFont" = ("'Lucida Grande', verdana, sans-serif", 3, bold)
    "TitleFont" = ("'Lucida Grande', verdana, sans-serif", 4, italic bold)
    "TitleFont2" = ("'Lucida Grande', verdana, sans-serif", 3, italic bold)
    "NoFont" = ("",2)
  ;

  /* Set embeds */
  %let EMaximize = %STR(<embed id="" Maximize"" src="" &Maximize"" hidden=true autostart=false></embed>);
  %let EMinimize = %STR(<embed id="" Minimize"" src="" &Minimize"" hidden=true autostart=false></embed>);
  %let EMenuCommand = %STR(<embed id="" MenuCommand"" src="" &MenuCommand"" hidden=true autostart=false></embed>);
  %let EMenuPopup = %STR(<embed id="" MenuPopup"" src="" &MenuPopup"" hidden=true autostart=false></embed>);

  %let ESystemQuestion = %STR(<embed id="" SystemQuestion"" src="" &SystemQuestion"" hidden=true autostart=false></embed>);
  %let EAppGPFault = %STR(<embed id="" AppGPFault"" src="" &AppGPFault"" hidden=true autostart=false></embed>);
  %let ESystemAsterisk = %STR(<embed id="" SystemAsterisk"" src="" &SysteMasterisk"" hidden=true autostart=false></embed>);
  %let ESystemExclamation = %STR(<embed id="" SystemExclamation"" src="" &SystemExclamation"" hidden=true autostart=false></embed>);

  %let ESystemStart = %STR(<embed id="" SystemStart"" src="" &SystemStart"" hidden=true autostart=true></embed>);

  replace colors /
    "docbg"        = cx&background
    "docfg"        = cx&menutext
    "contentbg"    = cx&menu
    "contentfg"    = cx&menutext
    "link1"        = cx&activetitle
    "link2"        = cx&background
    "Contitlefg"   = cx&menutext
    "Confolderfg"  = cx&menutext
    "Conentryfg"   = cx&menutext
    "systitlebg"   = cx&background
    "systitlefg"   = cx&foreground
    "titlebg"      = cx&background
    "titlefg"      = cx&foreground
    "proctitlebg"  = cx&background
    "proctitlefg"  = cx&foreground
    "captionbg"    = cx&background
    "captionfg"    = cx&menutext
    "bylinebg"     = cx&activetitle
    "bylinefg"     = cx&titletext
    "notebg"       = cx&hilight
    "notefg"       = cx&hilighttext
    "tablebg"      = cx&appworkspace
    "tableborder"  = cx&menutext
    "batchfg"      = cx&menutext
    "batchbg"      = cx&menu
    "databg"       = cx&menu
    "datafg"       = cx&menutext
    "databgstrong" = cx&menu
    "datafgstrong" = cx&menutext
    "databgemph"   = cx&menu
    "datafgemph"   = cx&menutext
    "headerbg"     = cx&activetitle
    "headerfg"     = cx&titletext
    "headerbgstrong" = cx&activetitle
    "headerfgstrong" = cx&titletext
    "headerbgemph" = cx&activetitle
    "headerfgemph" = cx&titletext
    "hilight"    = cx&hilight
    "hilighttext" = cx&hilighttext
  ;

  %let javascript = %STR(<script>function play(src){document.getElementById(' CS').innerHTML = '<embed src=""'+ document.getElementById(' '+src).src +'"" hidden=true autostart=true></embed>'}</script><span id="" CS""></span>);

  replace theme /
    "BackgroundImage" = "&wallpaper"
    "TOCAudio" = "&javascript&esystemstart&emaximize&eminimize&emenupopup&emenucommand"
    "BodyAudio" = "&javascript&esystemquestion&eappgpfault"
    "NoteImage" = "&note"
    "WarnImage" = "&warn"
    "FatalImage" = "&full"
    "ErrorImage" = "&empty"
    "Content Title" = "Table of Contents<hr>"
    "Watermark" = &watermark
    "prehtml flyover" = "<span>"
    "posthtml flyover" = "</span>"
    "Pre Title" = "<span style=""background:#&background"">"
    "Post Title" = "</span>"
  ;
  end;
  run;

  proc template;
    source styles.&output /file="&output..tpl";
  run;

%mend;

*%thm2tpl(roadrunner/roadrunner.theme,roadrunner,snd=1,ico=0,bg=1);
*%thm2tpl(nature/nature.theme,nature,snd=1,ico=0,bg=1);
*%thm2tpl(tropical/tropical.theme,tropical,snd=1,ico=0,bg=1);
*%thm2tpl(hell/hell.theme,hell,snd=1,ico=0,bg=1);
*%thm2tpl(heaven/heaven.theme,heaven,snd=1,ico=0,bg=1);