home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Graphics / Graphics.zip / gif_text.zip / mkgiftxt.cmd < prev    next >
OS/2 REXX Batch file  |  1999-05-05  |  21KB  |  696 lines
  1. /* 05 May 1999:
  2.  
  3.  A front end to the GIF_TEXT addon -- this will take a request generated
  4. by MKGIFTXT.HTM, and return a link to GIF_TEXT. 
  5.  
  6. Note that this will work either as a cgi-bin script (for a generic, os/2
  7. cgi-bin-compatabile server,or as an addon for the SRE-http
  8. web server (http://www.srehttp.org). It will detect how it's being called, 
  9. and respond accordingly.
  10.  
  11. Note that when used as cgi-bin, many servers have "request options"
  12. limit of 256 characters (that is, it will only recognize the first 256
  13. characters after the ?).  Since MKGIFTXT uses an IMG= link to display results,
  14. which is always interpreted as a GET request, this limitation is likely to
  15. arise when you've selected a lot of options in mkgiftxt.htm.  This is a problem,
  16. but there is no obvious work-around other then NOT specifying unneeded 
  17. options (which means mkgiftxt.htm should be edited, with unnecessary
  18. options removed).
  19.  
  20. There are a few user changable parameters: see below for descriptions.
  21.  
  22. */
  23.  
  24. /*  ---------------- Begin User Changeable Parameters ------------*/
  25.  
  26. /* "Styles" directory. Should be a fully qualified directory (typically, you
  27.     should use the GIF_DIR_ROOT directory you specified in GIF_TEXT.CMD
  28.     Set to '' if you don't want to support these styles */
  29.  
  30. STYLES_DIR='\goserve\alphabyt'
  31.  
  32. /* The "base directory" of the alphabytes. 
  33.    This is only needed if you use the SAVEIT option (to enable
  34.    downloads); and if you want to use the "list fonts, backgrounds,
  35.    and color slides" option */
  36.  
  37. GIF_DIR_ROOT='\goserve\alphabyt'
  38.  
  39. /* The "ttf fonts" root directory.  Used if you want to use the 
  40.    "list ttf fonts" option */
  41.  
  42. TTF_DIR_ROOT='\ttf'
  43.  
  44. /* Maximum number of "temporary" files (to allow downloading)
  45.    These will have names of MKGIF???.GIF, in the GIF_DIR_ROOT
  46.    directory.   Only used if SAVEIT option specified.
  47.    If 0, then no "saving of temporary files" is permitted */
  48. max_tempfiles=50
  49.  
  50.  
  51. /*  ---------------- End User Changable Parameters ------------*/
  52.  
  53.  
  54. parse arg  ddir, tempfile, reqstrg,list,verb ,uri,user, ,
  55.           basedir ,workdir,privset,enmadd,transaction,verbose, ,
  56.          servername,host_nickname,homedir
  57.  
  58. signal on syntax name err1
  59. signal on error name err1
  60.  
  61. verboseout=1            /* verbose response */
  62. styles_dir=strip(styles_dir,'t','\')
  63. gif_dir_root=strip(gif_dir_root,'t','\')
  64. ttf_dir_root=strip(ttf_dir_root,'t','\')
  65.  
  66.  
  67. /* check for CGI-BIN call */
  68. is_cgi=0
  69. if verb="" then do    /* is it cgi-bin? */
  70.    verb = value("REQUEST_METHOD",,'os2environment')
  71.    if verb="" then do
  72.         say " Sorry, this is a web server utility. "
  73.         exit
  74.    end /* do */
  75.    is_cgi=1
  76.    if verb="GET" then do
  77.      list=value("QUERY_STRING",,'os2environment') 
  78.    end
  79.    else  do
  80.      len=value('CONTENT_LENGTH',,'os2environment')
  81.      list=charin(,,len)
  82.    end
  83.    ref='mkgiftxt.htm'
  84. end
  85. else do
  86.    if verb='GET' then parse var uri . '?' list
  87.    ref=reqfield('referer')
  88. end
  89.  
  90.  
  91. /* look for list= option */
  92. if abbrev(translate(strip(list)),'LIST=')=1 then do  /* list some files, etc */
  93.   call makelist
  94.   if result=2 then return '200 ok'   /* a gif file was displayed? */
  95.   signal alldone        /* alldone will appropriately write the foo1 variable */
  96. end
  97.  
  98. /* look for "style" option, and use/save the appropriate "style" (if available) */
  99. l0=list
  100. lnew=''
  101. newtext=''; styfile='' ;is_style=0
  102. saveit=0
  103. do until l0=''
  104.     parse var l0 a1 '&' l0
  105.     parse var a1 a1a '=' a1b ; a1a=translate(a1a)
  106.     select
  107.     when a1a="MESSAGE" | a1a="TEXT" then do
  108.          newtext=a1b
  109.     end
  110.     when a1a='STYLE' then do
  111.         if styles_dir='' | styles_dir=0 then iterate /* suppress styles */
  112.         if a1b<>'' & a1b<>0 then do
  113.           styfile=a1b
  114.           if pos('.',a1b)=0 & a1b<>'' & a1b<>0 then styfile=styfile'.STY'
  115.           styfile=strip(translate(styfile,'\','/'),'l','\')
  116.           is_style=1
  117.         end
  118.     end /* do */
  119.     when a1a='SAVE_STYLE' | a1a='STYLE_SAVE' then do  /* otherwise, interpret as "use style" */
  120.         if styles_dir='' | styles_dir=0 then iterate /* suppress styles */
  121.         if a1b=1 then is_style=2
  122.     end /* do */
  123.     when a1a='SAVEIT' & MAX_TEMPFILES>0 then do
  124.          if a1b=1  then saveit=1
  125.     end /* do */
  126.     when abbrev(a1a,'VERBOSE')=1 then verboseout=a1b
  127.     otherwise do
  128.        if lnew='' then 
  129.           lnew=a1
  130.        else
  131.           lnew=lnew||'&'||a1
  132.     end
  133.     end
  134. end /* do */
  135.  
  136. /* Read results from style file? */
  137. if is_style>0 then do
  138.    if styfile='' | styfile=0 then styfile='DEFAULT.STY'
  139.    oof=styles_dir'\'styfile
  140.  
  141.  
  142.    if is_style=2 then do                /* save list, minus text, in a style file */
  143.      foo=stream(oof,'c','open write')
  144.      if abbrev(translate(foo),'READY')=1 then do  /* writeable ... */
  145.         l2=charout(oof,lnew,1) 
  146.         foo=stream(oof,'c','close')
  147.      end
  148.      else do
  149.         styfile='Unable to write to 'styfile
  150.      end /* do */
  151.    end /* do */
  152.    else do                      /* read from style file */
  153.      goo=stream(oof,'c','query exists')
  154.      if goo<>'' then do
  155.        foo=stream(oof,'c','open read')
  156.        l2=charin(oof,1,chars(oof)) 
  157.        foo=stream(oof,'c','close')
  158.        list='TEXT='||newtext||'&'l2
  159.      end
  160.      else
  161.        styfile='Unable to read from ' styfile
  162.    end
  163. end /* do */
  164.  
  165. /* save results to file (for downloading?). If so. specify
  166. a CACHE=GTMP???.gif option, but first SEE if > max_tempfiles
  167. (if so, delete oldest ones). */
  168.  
  169. if saveit=1 then do
  170.    fdo=sysfiletree(gif_dir_root'\GTMP*.GIF',foos,'FT')
  171.    if  foos.0>max_tempfiles then do     /* delete several of them */
  172.       garg=min(5,1+(max_tempfiles/3))
  173.       do io=1 to garg
  174.          call deleteold
  175.       end /* do */
  176.       call pmprintf(' MK_GifTxt: Deleted 'garg 'old temporary files ')
  177.    end
  178.    tt=gif_dir_root'\GTMP???.GIF'
  179.  
  180.    foo=rxfuncquery('rexxlibregister')
  181.    if foo<>0 then             /* rexx lib is not loaded */
  182.       newf=systempfilename(tt)
  183.    else
  184.       newf=dostempname(tt)
  185.    cname=filespec('n',newf)
  186.    list=list'&CACHE2='cname
  187. end
  188.  
  189.  
  190. list=list||'&MESSAGE.GIF'
  191. crlf='0d0a'x
  192.  
  193. errm1=""
  194. uj=length(list)
  195. if is_cgi=0 then do
  196.    img0='<IMG src="/GIF_TEXT?'||list||'">'
  197. end
  198. else do
  199.   if uj > 245 then do          /* long request; drop null = options */
  200.        olist=""
  201.        do until list=""
  202.              parse var list av '&' list
  203.              parse var av v1 '=' v2
  204.              if v2<>'' then olist=olist||av||'&'
  205.         end 
  206.         olist=strip(olist,'t','&')
  207.         if verboseout=1 then
  208.            errm1="<p><B>Caution:</b> A long request was shortened by removing empty-valued options. In some cases this will effect the final results.<p>"
  209.         list=olist
  210.   end /* do */
  211.   if length(list)>245 then do
  212.       errm1="<p><B>Warning:</b> This server may not be able to handle this long ("||length(list)" characters) CGI-BIN IMG request </b><p> "
  213.   end
  214.   img0='<IMG src="/cgi-bin/GIF_TEXT?'||list||'">'
  215. end             /* is cgi */
  216.  
  217. iv=translate(img0)
  218. /*parse var iv . 'SLIDE=' goon '&' . */
  219.  
  220. goon=pos('SLIDE=',iv)+pos('SLIDE_',iv)
  221. if goon>0 & verboseout=1 then 
  222.    extramess='<b>Note...</b> creating images that use <em>color slides</eM> may require a few minutes  '
  223. else
  224.   extramess=""
  225.  
  226. img=img0
  227. fimg2="" ; tmp=""
  228.  do until img=""
  229.       parse var img a1 '&' img
  230.         if tmp="" then
  231.            tmp=a1
  232.         else
  233.           tmp=tmp'&'a1
  234.         if length(tmp)>80 then do
  235.             if img<>""  then tmp=tmp'&'
  236.             fimg2=fimg2'<br>'||fixit(tmp)
  237.             tmp=""
  238.         end
  239. end /* do */
  240. if tmp<>"" then fimg2=fimg2'<br>'||fixit(tmp)
  241. fimg=fimg2
  242.  
  243. retmess=' Return to <a href="'ref'">GIF_Text input form </a> <p>'
  244.  
  245. foo1='<HTML><head><TITLE>Generating A Graphical Message</title></head>'crlf
  246. foo1=foo1||'<body>'
  247. if verboseout=1 then do
  248.   foo1=foo1||'<h2>Generating a graphical message </h2> ' crlf||extramess||'<p>'
  249.   foo1=foo1||' This image is generated from:<br><code>'||fimg||'<p>'crlf
  250. end
  251. foo1=foo1||'<br><center>'||img0||'</center>'||errm1'</center><br><hr>'
  252.  
  253.  
  254. foo1=foo1'<ul><li>'retmess||crlf
  255. if is_style=1  & verboseout=1 then do
  256.    foo1=foo1||'<li> Note: <b>using</b> specifications stored in style file: 'styfile
  257. end /* do */
  258. if is_style=2 & verboseout=1 then do
  259.    foo1=foo1||'<li> Note: <b>storing</b> specifications in style file: 'styfile
  260. end /* do */
  261.  
  262. /* add a "gif_text cache" element */
  263. if saveit=1 then do
  264.   foo1=foo1||crlf||'<br><br><li><p><em>To download a file containing this image ... </em><ol>'crlf
  265.   foo1=foo1||' <li>Wait till the image is <b>completely</b> drawn 'crlf
  266.   if is_cgi=0 then
  267.     foo1=foo1||'<li> <a href="/gif_text?cache2='cname'">  download the image file </a> ('cname') 'crlf
  268.   else
  269.     foo1=foo1||'<li> <a href="/cgi-bin/gif_text?cache2='cname'">  download the .GIF file </a> 'crlf
  270.   foo1=foo1||'</ol>'crlf
  271. end /* do */
  272.  
  273.  
  274. alldone: nop
  275.  
  276. foo1=foo1||'</ul><hr></body></html>'
  277.  
  278. if is_cgi=1 then do
  279.   Say "Content-type: text/html"
  280.   Say
  281.   call charout,foo1
  282.   return
  283. end
  284.  
  285. foo=value('SREF_PREFIX',,'os2environment')
  286.  
  287. if foo='' then do
  288.   exp=value(enmadd||'FIX_EXPIRE',,'os2environment')
  289.   if exp>0 then a=sref_expire_response(0.1,length(foo1),'text/html')
  290.   'var type text/html name foo1 '
  291.   return '200 ok'
  292. end
  293. else do
  294.    foo=sref_gos('VAR type text/html name foo1',foo1)
  295.    return foo 
  296. end /* do */
  297.  
  298.  
  299. /* ------------------------------*/
  300.  
  301. fixit:procedure
  302. parse arg adesc
  303.  
  304. adesc=a_replacestrg(adesc,'&','&','ALL')
  305. adesc=a_replacestrg(adesc,'<','<','ALL')
  306. adesc=a_replacestrg(adesc,'>','>','ALL')
  307. adesc=a_replacestrg(adesc,'"','"','ALL')
  308. return adesc
  309.  
  310.  
  311.  
  312. /* ------------------------------*/
  313. a_replacestrg:
  314.  
  315. exactmatch=0
  316. backward=0 ; doall=0
  317.  
  318. parse arg astring ,  target   , putme , type , exactmatch
  319.  
  320. type = translate(type)
  321. if type="BACKWARD" then backward="YES"
  322. if type="ALL" then doall="YES"
  323.  
  324. iat=1
  325. joelen=length(target)
  326. joelen2=length(putme)
  327.  
  328. doagain:                /* here if doall=yes */
  329.  if exactmatch="YES" then do
  330.     if   backward="YES" then
  331.         joe= lastpos(target,astring)
  332.     else
  333.         joe= pos(target,astring,iat)
  334.  end
  335.  else do
  336.    if   backward="YES" then
  337.         joe= lastpos(translate(target),translate(astring))
  338.     else
  339.         joe= pos(translate(target),translate(astring),iat)
  340.  end
  341.  if joe=0 then
  342.          return astring
  343.  
  344.  astring=delstr(astring,joe,joelen)
  345.  if putme<>' ' then
  346.     astring=insert(putme,astring,joe-1)
  347.  
  348.  if doall="YES" then do
  349.      iat=joe+joelen2
  350.      signal doagain
  351.  end
  352. /* else, all done */
  353.  return astring
  354.  
  355.  
  356. /* ------------------- */
  357.  
  358. deleteold:              /* real primitive search */
  359.   oldest='999999999999999' ; oldid=0
  360.   do ijo=1 to foos.0
  361.      parse var foos.ijo adate . 
  362.      if adate<oldest  then do
  363.          oldest=adate ; oldid=ijo
  364.      end /* do */
  365.   end       /* io loop */
  366.   parse var foos.oldid . . . afile
  367.   idid=sysfiledelete(strip(afile))
  368.   foos.oldid='99999999999999999999'
  369.   return 0
  370.  
  371.  
  372.  
  373. /************************/
  374. /* make a listing */
  375. makelist:
  376. crlf='0d0a'x
  377. parse upper var list . '=' todo ';' filename
  378.  
  379. select
  380.   when todo='FONTS' then do
  381.     foo1='<HTML><head><TITLE>GIF_text: available fonts</title></head>'crlf
  382.     foo1=foo1||'<body>'
  383.     foo1=foo1||'<h2>Alphabyte & complete fonts available to GIF_text</h2>'crlf
  384.      aa=gif_dir_root'\*.IND'
  385.      foo=sysfiletree(aa,'gots','FOS') 
  386.      foo1=foo1||'# of alphabyte and complete fonts available: 'gots.0||crlf
  387.      foo1=foo1||'<table cellpadding=2><tr>'
  388.      i1=0
  389.      LG=length(gif_dir_root)+2
  390.      do mm=1 to gots.0
  391.           aa=gots.mm
  392.  
  393.           aasay=substr(aa,LG)
  394.           iaa=lastpos('\',aasay)
  395.           aasay=substr(aasay,iaa+1)
  396.           parse var aasay aasay '.' . /* the font name */
  397.  
  398. /* choose a sample of this font */
  399.           parse var aa aa2 '.' .
  400.           aa2=aa||'.gif'    /* first, check for complete font */
  401.           aagif=''
  402.           if stream(aa2,'c','query exists')<>'' then aagif=aa2
  403.           if aagif='' then do   /* no complete, look for A.GIF */
  404.             iaa=lastpos('\',aa)
  405.             aa2=left(aa,iaa)||'A.GIF'
  406.             if stream(aa2,'c','query exists')<>'' then aagif=aa2
  407.           end /* do */
  408.           if aagif='' then do   /* no A.GIF, look for name-a.gif */
  409.               aa2=left(aa,iaa)||aasay||'-A.GIF'
  410.               if stream(aa2,'c','query exists')<>'' then aagif=aa2
  411.           end /* do */
  412.  
  413.           if aagif='' then do   /* find any gif in this directorty */
  414.             aagif=left(aa,iaa)'*.gif'
  415.             oof=sysfiletree(aagif,'aagifs','FO')
  416.             if aagifs.0>0 then do
  417.               if aagifs.0>3 then 
  418.                  aagif=aagifs.3
  419.               else
  420.                  aagif=aagifs.1
  421.             end
  422.           end
  423.  
  424.           if aagif<>'' then do          /* write a "link" to table */
  425.              aagif2=substr(aagif,lg)
  426.              aasay='<a href="/MKGIFTXT?LIST=DISP_FONT;'aagif2'">'aasay'</a>'
  427.           end 
  428.  
  429.           i1=i1+1
  430.  
  431.           foo1=foo1||'<td><code>'||aasay||'</code></td>'||crlf
  432.           if i1=6 then do
  433.                i1=0
  434.               foo1=foo1||'</tr><tr>'||crlf
  435.           end /* do */
  436.      end 
  437.      foo1=foo1||'</table></body></html>'
  438.      return 1
  439.    end
  440.  
  441.    when todo='TTFFONTS' | todo='TTFFONTS_ALL' then do
  442.     foo1='<HTML><head><TITLE>GIF_text: available TTF fonts</title></head>'crlf
  443.     foo1=foo1||'<body>'
  444.     foo1=foo1||'<h2>TTF fonts available to GIF_text</h2>'crlf
  445.      aa=ttf_dir_root'\*.TTF'
  446.      foo=sysfiletree(aa,'gots','FOS') 
  447.      foo1=foo1||'# of TTF fonts available: 'gots.0||crlf
  448.      foo1=foo1||'<table cellpadding=2><tr>'
  449.      i1=0
  450.      LG=length(ttf_dir_root)+2
  451.      allem='<a href="/mkgiftxt?LIST=DISP_TTFFONT'
  452.      allem2='">Sample of all the above</a>'
  453.  
  454.      do mm=1 to gots.0
  455.           aa=gots.mm
  456.           aa=substr(aa,LG)
  457.           parse var aa aa '.' .
  458.           allem=allem||';'||aa
  459.  
  460.           aa='<a href="/mkgiftxt?LIST=DISP_TTFFONT;'aa'">'aa'</a>'
  461.           foo1=foo1||'<td><code>'||aa||'</code></td>'||crlf
  462.           i1=i1+1
  463.           if i1=6 then do
  464.               i1=0
  465.               foo1=foo1||'</tr><tr>'||crlf
  466.           end
  467.      end /* do */
  468.      if todo='TTFFONTS_ALL' then do
  469.          foo1=foo1||'<tr><td colspan=2>'||allem||allem2'</td>'
  470.      end
  471.      if filename<>'' then do
  472.          foo1=foo1||'<tr><td colspan=2><a href="'filename'">View samples</a></td>'
  473.      end /* do */
  474.      foo1=foo1||'</table></body></html>'
  475.  
  476.      return 1
  477.  
  478.    end
  479.  
  480.    when todo='SLIDES' then do
  481.     foo1='<HTML><head><TITLE>GIF_text: available color slides</title></head>'crlf
  482.     foo1=foo1||'<body>'
  483.     foo1=foo1||'<h2>Color slides available to GIF_text</h2>'crlf
  484.      aa=gif_dir_root'\slides\*.gif'
  485.      foo=sysfiletree(aa,'gots','FOS') 
  486.      foo1=foo1||'# of color slides: 'gots.0||crlf
  487.      foo1=foo1||'<TABLE CELLPADDING=2>'
  488.      LG=LENGTH(GIF_DIR_ROOT)+1
  489.      I1=0
  490.      do mm=1 to gots.0
  491.           aa=gots.mm
  492.           aa=substr(aa,lG)
  493.           parse var aa aa '.' .
  494.           aa='<a href="/mkgiftxt?list=DISP_SLIDE;'aa'">'aa'</a>'
  495.           i1=i1+1
  496.           foo1=foo1||'<td><code>'||aa||'</code></td>'||crlf
  497.           if i1=3 then do
  498.               i1=0
  499.               foo1=foo1||'</tr><tr>'||crlf
  500.           end
  501.      end 
  502.      foo1=foo1||'</TABLE></body></html>'
  503.  
  504.      return 1
  505.  
  506.    end
  507.  
  508.    when todo='BACKGROUNDS' then do
  509.     foo1='<HTML><head><TITLE>GIF_text: available backgrounds</title></head>'crlf
  510.     foo1=foo1||'<body>'
  511.     foo1=foo1||'<h2>Backgrounds available to GIF_text</h2>'crlf
  512.      aa=gif_dir_root'\backs\*.gif'
  513.      foo=sysfiletree(aa,'gots','FOS') 
  514.      foo1=foo1||'# of backgrounds: 'gots.0||crlf
  515.      foo1=foo1||'<table cellpadding=2><tr>'
  516.      i1=0
  517.      LG=LENGTH(GIF_DIR_ROOT)+1
  518.      do mm=1 to gots.0
  519.           aa=gots.mm
  520.           aa=substr(aa,lG)
  521.           parse var aa aa '.' .
  522.           aa='<a href="/mkgiftxt?list=DISP_BACKGROUND;'aa'">'aa'</a>'
  523.           i1=i1+1
  524.           foo1=foo1||'<td><code>'||aa||'</code></td>'||crlf
  525.           if i1=3 then do
  526.               i1=0
  527.               foo1=foo1||'</tr><tr>'||crlf
  528.           end
  529.      end /* do */
  530.      foo1=foo1||'</TABLE></body></html>'
  531.  
  532.      return 1
  533.  
  534.    end
  535.  
  536.    when todo='DISP_BACKGROUND' then do
  537.       if is_cgi=1 then do
  538.           foo1='<html><head><title>Sorry </title></head><body>DISP_BACKGROUND not suported under CGI </body></html>'
  539.           return 1
  540.       end /* do */
  541.  
  542.      filename=strip(filename)
  543.      aa=TRANSLATE(gif_dir_root||filename||'.gif','\','/')
  544.      foo=sref_gos('FILE type image/gif name 'aa)   
  545.      return 2
  546.    end
  547.  
  548.    when todo='DISP_SLIDE' then do
  549.       if is_cgi=1 then do
  550.           foo1='<html><head><title>Sorry </title></head><body>DISP_SLIDE not suported under CGI </body></html>'
  551.           return 1
  552.       end /* do */
  553.  
  554.      filename=strip(filename)
  555.      aa=TRANSLATE(gif_dir_root||filename||'.gif','\','/')
  556.      foo=sref_gos('FILE type image/gif name 'aa)   
  557.      return 2
  558.    end
  559.  
  560.    when todo='DISP_FONT' then do
  561.       if is_cgi=1 then do
  562.           foo1='<html><head><title>Sorry </title></head><body>DISP_FONT not suported under CGI </body></html>'
  563.           return 1
  564.       end /* do */
  565.  
  566.      filename=strip(filename)
  567.      aa=TRANSLATE(gif_dir_root||'\'filename,'\','/')
  568.      foo=sref_gos('FILE type image/gif name 'aa)   
  569.      return 2
  570.    end
  571.  
  572.    when todo='DISP_TTFFONT' then do
  573.       if is_cgi=1 then do
  574.           foo1='<html><head><title>Sorry </title></head><body>DISP_TTFONT not suported under CGI </body></html>'
  575.           return 1
  576.       end /* do */
  577.       foo=rxfuncquery('rxttf_image')
  578.       if foo=1 then 
  579.          call RxFuncAdd 'rxttf_image', 'RXTTF', 'rxttf_image'
  580.       foo=rxfuncquery('rxttf_image')
  581.       if foo=1 then DO
  582.          sTRING "Warning: RXTTF_IMAGE not available "
  583.          EXIT
  584.       END
  585.       aa='' ;nfs=0
  586.       do until filename=''
  587.          parse var filename aname ';' filename
  588.          aname=strip(aname)
  589.          aa=aa||TRANSLATE(ttf_dir_root||'\'aname,'\','/')||'.ttf'||' '
  590.          nfs=nfs+1
  591.       end
  592.       ttsize=16
  593.       if nfs=1 then ttsize=28
  594.       AA=CREATE_TTF_GIF(' AaBbCdDdEe1234!?$',aa,ttsize,tempfile)
  595.       foo=sref_gos('FILE erase type image/gif name 'aa)   
  596.  
  597.       return 2
  598.    end
  599.  
  600.  
  601.   otherwise   do    /* should not happen */
  602.     'string Bad option to MKGIFTXT: 'list
  603.     exit
  604.   end
  605. end  /* select */
  606.  
  607. return
  608.  
  609.  
  610.  
  611.  
  612.  
  613. create_ttf_gif:procedure expose red_text green_text blue_text ,
  614.                          red_back green_back blue_back  
  615.  
  616. parse arg message,ttffonts,psize,OUTFILE
  617. foo=rxfuncquery('rxgdloadfuncs')
  618. if foo=1 then do
  619.   Call RxFuncAdd 'RxgdLoadFuncs', 'RXGDUTIL', 'RxgdLoadFuncs'
  620.   Call RxgdLoadFuncs
  621. end
  622. foo=rxfuncquery('rxgdloadfuncs')
  623. if foo=1 then do
  624.    if verb="" then do
  625.         STRING "Sorry: RXGDUTIL.DLL is not available! Did you copy it to your LIBPATH? "
  626.         return ' '
  627.    end /* do */
  628.    say 'Sorry: RXGDUTIL.DLL is not available! Did you copy it to your LIBPATH? '
  629.    exit
  630. end /* do */
  631.  
  632.  
  633. /* compute size of image */
  634. totrows=0 ; totcols=0
  635. do mm=1 to words(ttffonts)
  636.    ttffont=strip(word(ttffonts,mm))
  637.    ttfname=filespec('n',ttffont)
  638.    parse var ttfname ttfname '.' .
  639.    rc = rxttf_image(ttfname': 'message,ttffont,psize, data)
  640.    if rc<>0 then do
  641.       say "Error in rxttf_image ("ttffont"): "rc 
  642.      exit
  643.    end 
  644.  
  645.    totROWS=data.!rows+totrows
  646.    totcols=max(totcols,data.!cols)
  647. end
  648. totrows=totrows+(2*words(ttffonts))
  649. totcols=totcols+1
  650.  
  651. im=rxgdimagecreate(totCOLS,totROWS)  /* initialize image */
  652.  
  653. ir0=1
  654. do mm=1 to words(ttffonts)
  655.    ttffont=strip(word(ttffonts,mm))
  656.    ttfname=filespec('n',ttffont)
  657.    parse var ttfname ttfname '.' .
  658.  
  659.    rc = rxttf_image(ttfname': 'message,ttffont,psize, data)
  660. /* Check for an error */
  661.   if rc<>0 then do
  662.     say "Error in rxttf_image ("ttffont"): "rc 
  663.     exit
  664.   end /* do */
  665.  
  666. /* create the gif */
  667.   MCOLS=data.!cols ; MROWS=data.!rows
  668.   transparent=0
  669.   call rxgdimagecolortransparent im,transparent
  670.  
  671.   oy=rxgdimagecolorallocate(im,red_back,green_back,blue_back)
  672.   text_color=rxgdimagecolorallocate(im,red_text,green_text,blue_text)
  673.   do ir=0 to data.!rows-1
  674.    aline=translate(data.ir,'01','0001'x)
  675.    do ic=1 to MCOLS
  676.       pxels.ic=substr(aline,ic,1)
  677.    end /* do */
  678.    styled  = RxgdImageSetStyle(im, pxels, data.!cols)         /* write transformed row back to */
  679.    ir0=ir0+1
  680.    rc = RxgdImageLine(im, 0,ir0,MCOLS-1,ir0,styled)        /*  the message image */
  681.  end /* do */
  682.  ir0=ir0+2
  683. end
  684. /* save image to file */
  685. foo=rxgdimagegif(im,outfile)
  686. Call RxgdImageDestroy im
  687.  
  688. RETURN OUTFILE
  689.  
  690.  
  691. /*********************/
  692. /* here on error */
  693. err1:
  694. say " error in mkgiftxt at " sigl '( ' rc
  695.  
  696.