/* 09 Sept 1999:

 A front end to the GIF_TEXT addon -- this will take a request generated
by MKGIFTXT.HTM, and return a link to GIF_TEXT. 

Note that this will work either as a cgi-bin script (for a generic, os/2
cgi-bin-compatabile server),or as an addon for the SRE-http
web server (http://www.srehttp.org). It will detect how it's being called, 
and respond accordingly.

Note that when used as cgi-bin, many servers have "request options"
limit of 256 characters (that is, it will only recognize the first 256
characters after the ?).  Since MKGIFTXT uses an IMG= link to display results,
which is always interpreted as a GET request, this limitation is likely to
arise when you've selected a lot of options in mkgiftxt.htm.  This is a problem,
but there is no obvious work-around other then NOT specifying unneeded 
options (which means mkgiftxt.htm should be edited, with unnecessary
options removed).

There are a few user changable parameters: see below for descriptions.

*/

/*  ---------------- Begin User Changeable Parameters ------------*/

/* "Styles" directory. Should be a fully qualified directory (typically, you
    should use the GIF_DIR_ROOT directory you specified in GIF_TEXT.CMD
    Set to '' if you don't want to support these styles */

STYLES_DIR='\OS2Httpd\alphabyt'

/* The "base directory" of the alphabytes. 
   This is only needed if you use the SAVEIT option (to enable
   downloads); and if you want to use the "list fonts, backgrounds,
   and color slides" option */

GIF_DIR_ROOT='\OS2Httpd\alphabyt'

/* The "ttf fonts" root directory.  Used if you want to use the 
   "list ttf fonts" option */

TTF_DIR_ROOT='h:\os2\mdos\winos2\system'

/* Maximum number of "temporary" files (to allow downloading)
   These will have names of MKGIF???.GIF, in the GIF_DIR_ROOT
   directory.   Only used if SAVEIT option specified.
   If 0, then no "saving of temporary files" is permitted */
max_tempfiles=50


/* Web accessible location of MKGIFTXT.HTM or MKGIFRM.HTM -- 
   this is used in a  "return to GIF_TEXT" link.
   For example, if you are providing MKGIFTXT.HTM to the world using
   a link of http://foo.bar.com/graphics/giftxt/mkgiftxt.htm, 
   then set HTML_URI="/graphics/giftxt/mkgiftxt.htm"
   Or, leave this blank to use a default   */
HTML_URI=''

/* Web accessible location of the MKGIFTXT script --
   this is used when displaying ttf fonts, color slides, etc.
   For example:
     when run as an srehttp addon: "SCRIPT_URI=/MKGIFTXT"
     when run as a cgi-bin script: "SCRIPT_URI="/CGI-BIN/MKGIFTXT"
   Or, leave this blank to use a default
*/
SCRIPT_URI=''

/*  ---------------- End User Changable Parameters ------------*/


parse arg  ddir, tempfile, reqstrg,list,verb ,uri,user, ,
          basedir ,workdir,privset,enmadd,transaction,verbose, ,
         servername,host_nickname,homedir
                     
signal on syntax name err1
signal on error name err1

verboseout=1            /* verbose response */
styles_dir=strip(styles_dir,'t','\')
gif_dir_root=strip(gif_dir_root,'t','\')
ttf_dir_root=strip(ttf_dir_root,'t','\')


/* check for CGI-BIN call */
is_cgi=0
if verb="" then do    /* is it cgi-bin? */
   verb = value("REQUEST_METHOD",,'os2environment')
   if verb="" then do
        say " Sorry, this is a web server utility. "
        exit
   end /* do */
   is_cgi=1
   if verb="GET" then do
     list=value("QUERY_STRING",,'os2environment') 
   end
   else  do
     len=value('CONTENT_LENGTH',,'os2environment')
     list=charin(,,len)
   end
   if html_uri='' then
      ref='/mkgiftxt.htm' 
   else
      ref=html_uri
   if script_uri='' then script_uri='/cgi-bin/mkgiftxt'
end
else do
   if verb='GET' then parse var uri . '?' list
   if html_uri<>'' then 
      ref=html_uri
   else
      ref=reqfield('referer')
   if script_uri='' then script_uri='/mkgiftxt'
end
/* look for list= option */
if abbrev(translate(strip(list)),'LIST=')=1 then do  /* list some files, etc */
  call makelist
  if result=2 then return '200 ok'   /* a gif file was displayed? */
  if result=3 then do           /* cgi-bin return */
      bb=charout(,foo1)
      return '200 ok'
  end /* do */
  signal alldone        /* alldone will appropriately write the foo1 variable */
end

/* look for "style" option, and use/save the appropriate "style" (if available) */
l0=list
lnew=''
newtext=''; styfile='' ;is_style=0
saveit=0
do until l0=''
    parse var l0 a1 '&' l0
    parse var a1 a1a '=' a1b ; a1a=translate(a1a)
    select
    when a1a="MESSAGE" | a1a="TEXT" then do
         newtext=a1b
    end
    when a1a='STYLE' then do
        if styles_dir='' | styles_dir=0 then iterate /* suppress styles */
        if a1b<>'' & a1b<>0 then do
          styfile=a1b
          if pos('.',a1b)=0 & a1b<>'' & a1b<>0 then styfile=styfile'.STY'
          styfile=strip(translate(styfile,'\','/'),'l','\')
          is_style=1
        end
    end /* do */
    when a1a='SAVE_STYLE' | a1a='STYLE_SAVE' then do  /* otherwise, interpret as "use style" */
        if styles_dir='' | styles_dir=0 then iterate /* suppress styles */
        if a1b=1 then is_style=2
    end /* do */
    when a1a='SAVEIT' & MAX_TEMPFILES>0 then do
         if a1b=1  then saveit=1
    end /* do */
    when abbrev(a1a,'VERBOSE')=1 then verboseout=a1b
    otherwise do
       if lnew='' then 
          lnew=a1
       else
          lnew=lnew||'&'||a1
    end
    end         /* select */
end /* do */

/* Read results from style file? */
if is_style>0 then do
   if styfile='' | styfile=0 then styfile='DEFAULT.STY'
   oof=styles_dir'\'styfile


   if is_style=2 then do                /* save list, minus text, in a style file */
     foo=stream(oof,'c','open write')
     if abbrev(translate(foo),'READY')=1 then do  /* writeable ... */
        l2=charout(oof,lnew,1) 
        foo=stream(oof,'c','close')
     end
     else do
        styfile='Unable to write to 'styfile
     end /* do */
   end /* do */
   else do                      /* read from style file */
     goo=stream(oof,'c','query exists')
     if goo<>'' then do
       foo=stream(oof,'c','open read')
       l2=charin(oof,1,chars(oof)) 
       foo=stream(oof,'c','close')
       list='TEXT='||newtext||'&'l2
     end
     else
       styfile='Unable to read from ' styfile
   end
end /* do */

/* save results to file (for downloading?). If so. specify
a CACHE=GTMP???.gif option, but first SEE if > max_tempfiles
(if so, delete oldest ones). */

if saveit=1 then do
   fdo=sysfiletree(gif_dir_root'\GTMP*.GIF',foos,'FT')
   if  foos.0>max_tempfiles then do     /* delete several of them */
      garg=min(5,1+(max_tempfiles/3))
      do io=1 to garg
         call deleteold
      end /* do */
      call pmprintf(' MK_GifTxt: Deleted 'garg 'old temporary files ')
   end
   tt=gif_dir_root'\GTMP???.GIF'

   foo=rxfuncquery('rexxlibregister')
   if foo<>0 then             /* rexx lib is not loaded */
      newf=systempfilename(tt)
   else
      newf=dostempname(tt)
   cname=filespec('n',newf)
   list=list'&CACHE2='cname
end


list=list||'&MESSAGE.GIF'
crlf='0d0a'x

errm1=""
uj=length(list)
if is_cgi=0 then do
   img0='<IMG src="/GIF_TEXT?'||list||'">'
end
else do
  if uj > 245 then do          /* long request; drop null = options */
       olist=""
       do until list=""
             parse var list av '&' list
             parse var av v1 '=' v2
             if v2<>'' then olist=olist||av||'&'
        end 
        olist=strip(olist,'t','&')
        if verboseout=1 then
           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>"
        list=olist
  end /* do */
  if length(list)>245 then do
      errm1="<p><B>Warning:</b> This server may not be able to handle this long ("||length(list)" characters) CGI-BIN IMG request </b><p> "
  end
  img0='<IMG src="/cgi-bin/GIF_TEXT?'||list||'">'
end             /* is cgi */

iv=translate(img0)
/*parse var iv . 'SLIDE=' goon '&' . */

goon=pos('SLIDE=',iv)+pos('SLIDE_',iv)
if goon>0 & verboseout=1 then 
   extramess='<b>Note...</b> creating images that use <em>color slides</eM> may require a few minutes  '
else
  extramess=""

img=img0
fimg2="" ; tmp=""
 do until img=""
      parse var img a1 '&' img
        if tmp="" then
           tmp=a1
        else
          tmp=tmp'&'a1
        if length(tmp)>80 then do
            if img<>""  then tmp=tmp'&'
            fimg2=fimg2'<br>'||fixit(tmp)
            tmp=""
        end
end /* do */
if tmp<>"" then fimg2=fimg2'<br>'||fixit(tmp)
fimg=fimg2

retmess=' Return to <a href="'ref'" target="form_frame">GIF_Text input form </a> <p>'

foo1='<HTML><head><TITLE>Generating A Graphical Message</title></head>'crlf
foo1=foo1||'<body>'
if verboseout=1 then do
  foo1=foo1||'<h2>Generating a graphical message </h2> ' crlf||extramess||'<p>'
  foo1=foo1||' This image is generated from:<br><code>'||fimg||'<p>'crlf
end
foo1=foo1||'<br><center>'||img0||'</center>'||errm1'</center><br><hr>'


foo1=foo1'<ul><li>'retmess||crlf
if is_style=1  & verboseout=1 then do
   foo1=foo1||'<li> Note: <b>using</b> specifications stored in style file: 'styfile
end /* do */
if is_style=2 & verboseout=1 then do
   foo1=foo1||'<li> Note: <b>storing</b> specifications in style file: 'styfile
end /* do */

/* add a "gif_text cache" element */
if saveit=1 then do
  foo1=foo1||crlf||'<br><br><li><p><em>To download a file containing this image ... </em><ol>'crlf
  foo1=foo1||' <li>Wait till the image is <b>completely</b> drawn 'crlf
  if is_cgi=0 then
    foo1=foo1||'<li> <a href="/gif_text?cache2='cname'">  download the image file </a> ('cname') 'crlf
  else
    foo1=foo1||'<li> <a href="/cgi-bin/gif_text?cache2='cname'">  download the .GIF file </a> 'crlf
  foo1=foo1||'</ol>'crlf
end /* do */


alldone: nop

foo1=foo1||'</ul><hr></body></html>'

if is_cgi=1 then do
  Say "Content-type: text/html"
  Say
  call charout,foo1
  return
end

foo=value('SREF_PREFIX',,'os2environment')

if foo='' then do
  exp=value(enmadd||'FIX_EXPIRE',,'os2environment')
  if exp>0 then a=sref_expire_response(0.1,length(foo1),'text/html')
  'var type text/html name foo1 '
  return '200 ok'
end
else do
   foo=sref_gos('VAR type text/html name foo1',foo1)
   return foo 
end /* do */


/* ------------------------------*/

fixit:procedure
parse arg adesc

adesc=a_replacestrg(adesc,'&','&amp;','ALL')
adesc=a_replacestrg(adesc,'<','&lt;','ALL')
adesc=a_replacestrg(adesc,'>','&gt;','ALL')
adesc=a_replacestrg(adesc,'"','&quot;','ALL')
return adesc



/* ------------------------------*/
a_replacestrg:

exactmatch=0
backward=0 ; doall=0

parse arg astring ,  target   , putme , type , exactmatch

type = translate(type)
if type="BACKWARD" then backward="YES"
if type="ALL" then doall="YES"

iat=1
joelen=length(target)
joelen2=length(putme)

doagain:                /* here if doall=yes */
 if exactmatch="YES" then do
    if   backward="YES" then
        joe= lastpos(target,astring)
    else
        joe= pos(target,astring,iat)
 end
 else do
   if   backward="YES" then
        joe= lastpos(translate(target),translate(astring))
    else
        joe= pos(translate(target),translate(astring),iat)
 end
 if joe=0 then
         return astring

 astring=delstr(astring,joe,joelen)
 if putme<>' ' then
    astring=insert(putme,astring,joe-1)

 if doall="YES" then do
     iat=joe+joelen2
     signal doagain
 end
/* else, all done */
 return astring


/* ------------------- */

deleteold:              /* real primitive search */
  oldest='999999999999999' ; oldid=0
  do ijo=1 to foos.0
     parse var foos.ijo adate . 
     if adate<oldest  then do
         oldest=adate ; oldid=ijo
     end /* do */
  end       /* io loop */
  parse var foos.oldid . . . afile
  idid=sysfiledelete(strip(afile))
  foos.oldid='99999999999999999999'
  return 0



/************************/
/* make a listing */
makelist:
crlf='0d0a'x
parse upper var list . '=' todo ';' filename
select
  when todo='FONTS' then do
    foo1='<HTML><head><TITLE>GIF_text: available fonts</title></head>'crlf
    foo1=foo1||'<body>'
    foo1=foo1||'<h2>Alphabyte &amp; complete fonts available to GIF_text</h2>'crlf
     aa=gif_dir_root'\*.IND'
     foo=sysfiletree(aa,'gots','FOS') 
     foo1=foo1||'# of alphabyte and complete fonts available: 'gots.0||crlf
     foo1=foo1||'<table cellpadding=2><tr>'
     i1=0
     LG=length(gif_dir_root)+2
     do mm=1 to gots.0
          aa=gots.mm

          aasay=substr(aa,LG)
          iaa=lastpos('\',aasay)
          aasay=substr(aasay,iaa+1)
          parse var aasay aasay '.' . /* the font name */

/* choose a sample of this font */
          parse var aa aa2 '.' .
          aa2=aa||'.gif'    /* first, check for complete font */
          aagif=''
          if stream(aa2,'c','query exists')<>'' then aagif=aa2
          if aagif='' then do   /* no complete, look for A.GIF */
            iaa=lastpos('\',aa)
            aa2=left(aa,iaa)||'A.GIF'
            if stream(aa2,'c','query exists')<>'' then aagif=aa2
          end /* do */
          if aagif='' then do   /* no A.GIF, look for name-a.gif */
              aa2=left(aa,iaa)||aasay||'-A.GIF'
              if stream(aa2,'c','query exists')<>'' then aagif=aa2
          end /* do */

          if aagif='' then do   /* find any gif in this directorty */
            aagif=left(aa,iaa)'*.gif'
            oof=sysfiletree(aagif,'aagifs','FO')
            if aagifs.0>0 then do
              if aagifs.0>3 then 
                 aagif=aagifs.3
              else
                 aagif=aagifs.1
            end
          end

          if aagif<>'' then do          /* write a "link" to table */
             aagif2=substr(aagif,lg)
             aasay='<a href="'script_uri'?LIST=DISP_FONT;'aagif2'">'aasay'</a>'
          end 

          i1=i1+1

          foo1=foo1||'<td><code>'||aasay||'</code></td>'||crlf
          if i1=6 then do
               i1=0
              foo1=foo1||'</tr><tr>'||crlf
          end /* do */
     end 
     foo1=foo1||'</table></body></html>'
     return 1
   end

   when todo='TTFFONTS' | todo='TTFFONTS_ALL' then do
    foo1='<HTML><head><TITLE>GIF_text: available TTF fonts</title></head>'crlf
    foo1=foo1||'<body>'
    foo1=foo1||'<h2>TTF fonts available to GIF_text</h2>'crlf
     aa=ttf_dir_root'\*.TTF'
     foo=sysfiletree(aa,'gots','FOS') 
     foo1=foo1||'# of TTF fonts available: 'gots.0||crlf
     foo1=foo1||'<table cellpadding=2><tr>'
     i1=0
     LG=length(ttf_dir_root)+2
     allem='<a href="'script_uri'?LIST=DISP_TTFFONT'
     allem2='">Sample of all the above</a>'

     do mm=1 to gots.0
          aa=gots.mm
          aa=substr(aa,LG)
          parse var aa aa '.' .
          allem=allem||';'||aa

          aa='<a href="'script_uri'?LIST=DISP_TTFFONT;'aa'">'aa'</a>'
          foo1=foo1||'<td><code>'||aa||'</code></td>'||crlf
          i1=i1+1
          if i1=6 then do
              i1=0
              foo1=foo1||'</tr><tr>'||crlf
          end
     end /* do */
     if todo='TTFFONTS_ALL' then do
         foo1=foo1||'<tr><td colspan=2>'||allem||allem2'</td>'
     end
     if filename<>'' then do
         foo1=foo1||'<tr><td colspan=2><a href="'filename'">View samples</a></td>'
     end /* do */
     foo1=foo1||'</table></body></html>'

     return 1

   end

   when todo='SLIDES' then do
    foo1='<HTML><head><TITLE>GIF_text: available color slides</title></head>'crlf
    foo1=foo1||'<body>'
    foo1=foo1||'<h2>Color slides available to GIF_text</h2>'crlf
     aa=gif_dir_root'\slides\*.gif'
     foo=sysfiletree(aa,'gots','FOS') 
     foo1=foo1||'# of color slides: 'gots.0||crlf
     foo1=foo1||'<TABLE CELLPADDING=2>'
     LG=LENGTH(GIF_DIR_ROOT)+1
     I1=0
     do mm=1 to gots.0
          aa=gots.mm
          aa=substr(aa,lG)
          parse var aa aa '.' .
          aa='<a href="'script_uri'?list=DISP_SLIDE;'aa'">'aa'</a>'
          i1=i1+1
          foo1=foo1||'<td><code>'||aa||'</code></td>'||crlf
          if i1=3 then do
              i1=0
              foo1=foo1||'</tr><tr>'||crlf
          end
     end 
     foo1=foo1||'</TABLE></body></html>'

     return 1

   end

   when todo='BACKGROUNDS' then do
    foo1='<HTML><head><TITLE>GIF_text: available backgrounds</title></head>'crlf
    foo1=foo1||'<body>'
    foo1=foo1||'<h2>Backgrounds available to GIF_text</h2>'crlf
     aa=gif_dir_root'\backs\*.gif'
     foo=sysfiletree(aa,'gots','FOS') 
     foo1=foo1||'# of backgrounds: 'gots.0||crlf
     foo1=foo1||'<table cellpadding=2><tr>'
     i1=0
     LG=LENGTH(GIF_DIR_ROOT)+1
     do mm=1 to gots.0
          aa=gots.mm
          aa=substr(aa,lG)
          parse var aa aa '.' .
          aa='<a href="'script_uri'?list=DISP_BACKGROUND;'aa'">'aa'</a>'
          i1=i1+1
          foo1=foo1||'<td><code>'||aa||'</code></td>'||crlf
          if i1=3 then do
              i1=0
              foo1=foo1||'</tr><tr>'||crlf
          end
     end /* do */
     foo1=foo1||'</TABLE></body></html>'

     return 1

   end

   when todo='DISP_BACKGROUND' then do
     filename=strip(filename); 
     aa=TRANSLATE(gif_dir_root||filename||'.gif','\','/')
     if is_cgi =1 then do
        mmm=stream(aa,'c','query size')
        if mmm=0 | mmm='' then do
          foo1='<html><head><title>Sorry </title></head><body>Problem displaying 'filename' </body></html>'
          return 1  
        end
        foo1='Content-type: image/gif'||'0d0a'x||'0d0a'x
        foo1=foo1||charin(aa,1,mmm)
        return 3
     end /* do */
     foo=sref_gos('FILE type image/gif name 'aa)   
    
     return 2
   end

   when todo='DISP_SLIDE' then do
     filename=strip(filename)
     aa=TRANSLATE(gif_dir_root||filename||'.gif','\','/')
     if is_cgi =1 then do
        mmm=stream(aa,'c','query size')
        if mmm=0 | mmm='' then do
          foo1='<html><head><title>Sorry </title></head><body>Problem displaying 'filename' </body></html>'
          return 1  
        end
        foo1='Content-type: image/gif'||'0d0a'x||'0d0a'x
        foo1=foo1||charin(aa,1,mmm)
        return 3
     end /* do */
     foo=sref_gos('FILE type image/gif name 'aa)   
     return 2
   end

   when todo='DISP_FONT' then do

     filename=strip(filename)
     aa=TRANSLATE(gif_dir_root||'\'filename,'\','/')
     if is_cgi =1 then do
        mmm=stream(aa,'c','query size')
        if mmm=0 | mmm='' then do
          foo1='<html><head><title>Sorry </title></head><body>Problem displaying 'filename' </body></html>'
          return 1  
        end
        foo1='Content-type: image/gif'||'0d0a'x||'0d0a'x
        foo1=foo1||charin(aa,1,mmm)
        return 3
     end /* do */
     foo=sref_gos('FILE type image/gif name 'aa)   
     return 2
   end

   when todo='DISP_TTFFONT' then do
      foo=rxfuncquery('rxttf_image')
      if foo=1 then 
         call RxFuncAdd 'rxttf_image', 'RXTTF', 'rxttf_image'
      foo=rxfuncquery('rxttf_image')
      if foo=1 then DO
         sTRING "Warning: RXTTF_IMAGE not available "
         EXIT
      END
      aa='' ;nfs=0
      do until filename=''
         parse var filename aname ';' filename
         aname=strip(aname)
         aa=aa||TRANSLATE(ttf_dir_root||'\'aname,'\','/')||'.ttf'||' '
         nfs=nfs+1
      end
      ttsize=16
      if nfs=1 then ttsize=28
      if is_cgi=1 then do
          goo=gif_dir_root
          tempfile=systempfilename(goo||'\TTFG????.TMP')
      end /* do */
      AA=CREATE_TTF_GIF(' AaBbCdDdEe1234!?$',aa,ttsize,tempfile)
     if is_cgi =1 then do
        mmm=stream(aa,'c','query size')
        if mmm=0 | mmm='' then do
          foo1='<html><head><title>Sorry </title></head><body>Problem displaying 'filename' </body></html>'
          return 1  
        end
        foo1='Content-type: image/gif'||'0d0a'x||'0d0a'x
        foo1=foo1||charin(aa,1,mmm)
        fooc=stream(aa,'c','close')
        goo=sysfiledelete(aa)
        return 3
      end /* do */
      foo=sref_gos('FILE erase type image/gif name 'aa)   

      return 2
   end


  otherwise   do    /* should not happen */
    'string Bad option to MKGIFTXT: 'list
    exit
  end
end  /* select */

return





create_ttf_gif:procedure expose red_text green_text blue_text ,
                         red_back green_back blue_back  script_uri

parse arg message,ttffonts,psize,OUTFILE
foo=rxfuncquery('rxgdloadfuncs')
if foo=1 then do
  Call RxFuncAdd 'RxgdLoadFuncs', 'RXGDUTIL', 'RxgdLoadFuncs'
  Call RxgdLoadFuncs
end
foo=rxfuncquery('rxgdloadfuncs')
if foo=1 then do
   if verb="" then do
        STRING "Sorry: RXGDUTIL.DLL is not available! Did you copy it to your LIBPATH? "
        return ' '
   end /* do */
   say 'Sorry: RXGDUTIL.DLL is not available! Did you copy it to your LIBPATH? '
   exit
end /* do */


/* compute size of image */
totrows=0 ; totcols=0
do mm=1 to words(ttffonts)
   ttffont=strip(word(ttffonts,mm))
   ttfname=filespec('n',ttffont)
   parse var ttfname ttfname '.' .
   rc = rxttf_image(ttfname': 'message,ttffont,psize, data)
   if rc<>0 then do
      say "Error in rxttf_image ("ttffont"): "rc 
     exit
   end 

   totROWS=data.!rows+totrows
   totcols=max(totcols,data.!cols)
end
totrows=totrows+(2*words(ttffonts))
totcols=totcols+1

im=rxgdimagecreate(totCOLS,totROWS)  /* initialize image */

ir0=1
do mm=1 to words(ttffonts)
   ttffont=strip(word(ttffonts,mm))
   ttfname=filespec('n',ttffont)
   parse var ttfname ttfname '.' .

   rc = rxttf_image(ttfname': 'message,ttffont,psize, data)
/* Check for an error */
  if rc<>0 then do
    say "Error in rxttf_image ("ttffont"): "rc 
    exit
  end /* do */

/* create the gif */
  MCOLS=data.!cols ; MROWS=data.!rows
  transparent=0
  call rxgdimagecolortransparent im,transparent

  oy=rxgdimagecolorallocate(im,red_back,green_back,blue_back)
  text_color=rxgdimagecolorallocate(im,red_text,green_text,blue_text)
  do ir=0 to data.!rows-1
   aline=translate(data.ir,'01','0001'x)
   do ic=1 to MCOLS
      pxels.ic=substr(aline,ic,1)
   end /* do */
   styled  = RxgdImageSetStyle(im, pxels, data.!cols)         /* write transformed row back to */
   ir0=ir0+1
   rc = RxgdImageLine(im, 0,ir0,MCOLS-1,ir0,styled)        /*  the message image */
 end /* do */
 ir0=ir0+2
end
/* save image to file */
foo=rxgdimagegif(im,outfile)
Call RxgdImageDestroy im

RETURN OUTFILE


/*********************/
/* here on error */
err1:
say " error in mkgiftxt at " sigl '( ' rc

