/* */
/* Load up advanced REXX functions */
call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
call SysLoadFuncs

foo=rxfuncquery('rexxlibregister')
if foo=1 then do
 droprxlib=1 ; gotrxlib=0
 call rxfuncadd 'rexxlibregister','rexxlib', 'rexxlibregister'
 call rexxlibregister
end
foo=rxfuncquery('rxgdloadfuncs')
if foo=1 then do
  Call RxFuncAdd 'RxgdLoadFuncs', 'RXGDUTIL', 'RxgdLoadFuncs'
  Call RxgdLoadFuncs
end

say " This utility is meant to be used in conjunction with the gif_text utility "
say
say " Given a grid of fonts in a .GIF file, and a .IND file containing some "
say " basic info, this utility will create an 'alphabyte' -- "
say "      it will extract seperate .GIF files for each  character referenced "
say "      in the .IND file.   "
say " (this can be useful for debugging the .IND file)"
say

call charout , " Enter ind file (that contains info on the Grid Of Fonts) ? "
pull anind
if pos('.',anind)=0 then anind=anind'.ind'

yow=fileread(anind,lines,,'E')

textcolor='000000' ; backcolor='ffffff'
defgifs=' '; xoffset=0 ; yoffset=0 ; inrow=16 ; hchar=47  ; wchar=35 ;isbw=1
charset=' !"'||"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~"

do mm=1 to lines.0
   foo=strip(lines.mm)
   if abbrev(foo,';')=1 | foo="" then iterate
   if pos('=',foo)=0 then iterate
   parse var foo athing '=' stuff ; athing=strip(upper(athing))
   select
      when athing='DEFAULTS' then  defgifs=strip(stuff)
      when athing='TEXT' then do
               stuff2=get_from_hex(stuff)
              if stuff2<>' ' then textcolor=strip(stuff)
      end
      when athing='BACK' then do
         stuff2=get_from_hex(stuff)
         if stuff2<>' ' then backcolor=strip(stuff)
      end
      when athing='DEF_OFFSET' then do
             stuff=translate(stuff,' ',',')
             parse var stuff a1 a2
             if datatype(a1)='NUM'  then xoffset=a1
             if datatype(a2)='NUM'  then yoffset=a2
      end  /* Do */
      when athing='DEF_CHARSIZE' then do
             stuff=translate(stuff,' ',',')
             parse var stuff a1 a2
             if datatype(a1)='NUM'  then wchar=a1
             if datatype(a2)='NUM'  then hchar=a2
      end  /* Do */
      when athing='DEF_CHARS' then charset=stuff
      when athing='DEF_BW' then isbw=pos(strip(upper(stuff)),'Y YES 1')
      when athing='DEF_INROW' then
              if datatype(strip(stuff))='NUM' then inrow=strip(stuff)
      otherwise nop
   end  /* select */
end /* do */
im = RxgdImageCreateFromGIF(defgifs)
if im=1 | im=0 then  do
 say "Error, could not process " defgifs
  exit
end

say " Reading from fonts displayed in: " defgifs 
say " The following characters will be produced: " charset

backcolor=get_from_hex(backcolor)
   parse var backcolor bdefr bdefg bdefb
textcolor=get_from_hex(textcolor)
   parse var textcolor tdefr tdefg tdefb
ido=0
/* for each character in the charset ... */
/*do ic=1 to length(charset)*/
do ic=1 to length(charset)
     achar=substr(charset,ic,1)
     if achar=' ' then iterate

/* determine x offset: */
   irow=1+((ic-0.1)%inrow)
   icol=ic-((irow-1)*inrow)

/* upper left is 0,0 */
   xat=xoffset + ((icol-1)*wchar)
   yat=yoffset+ ((irow-1)*hchar)

   cim=rxgdimagecreate(wchar,hchar)

   foo=rxgdimagecopy(cim,im,0,0,xat,yat,wchar,hchar)


   foo=rxgdimagecolordeallocate(cim,0)
   oy1=rxgdimagecolorallocate(cim,bdefr,bdefg,bdefb)
   foo=rxgdimagecolordeallocate(cim,1)
   oy2=rxgdimagecolorallocate(cim,tdefr,tdefg,tdefb)

   acharg=achar
   if upper(achar)<>achar then acharg=achar'lc'

   if pos(upper(achar),'1234567890ABCDEFGHIJKLMNOPQRSTUVXWYZ#-_%$')=0 then DO
        FOO=c2D(ACHAR)
        ACHARg='ASC_'||FOO
   end  /* Do */

   acharg=acharg'.GIF'
  foo=rxgdimagegif(cim,acharG)
   say  " Writing character " achar "(@ offset "  xat yat ") to : " acharg
   ido=ido+1
  foo= RxgdImageDestroy(cim)


end /* do */
say " Total files written= " ido
foo= RxgdImageDestroy(im)

exit




/**************************/
/* convert ff21b3 "hex" color code to decimal r g b values
  If bad value, return ' /' */
get_from_hex:procedure
parse arg hval

hval=strip(strip(hval),,'"')
hval=strip(hval,,'#')
select 
  when length(hval)<>6 then return ' '
  when verify(translate(hval),'0123456789ABCDEF')>0 then return ' '
  otherwise do
    a1=left(hval,2)
    a2=substr(hval,3,2)
    a3=substr(hval,5,2)
    r=x2d(a1)
    g=x2d(a2)
    b=x2d(a3)
  end
end /* do */
return r ' ' g ' ' b

