/***************************************************************************

1]                    ICON.rexx: Attach Icons to Files
1]                       ARexx Example by Tom Beale

****************************************************************************/
ret = addlib("rexxsupport.library",0,-30,0)
arg dirpath .
/*
1]   ----------------------------- Read Icon Directory
1]                                 (Change j:Projects to the name
1]                                 of a drawer that contains your
1]                                 model icons)
*/
if dirpath = '' then dirpath = 'J:ARexx/Icons'
listing = showdir(dirpath,"F")
lasticon = 0
i. = ""
/*
1]   ----------------------------- Extract .info files from listing
*/
do a = 1 to words(listing)
      temp = word(listing,a)
      if temp = '.info' then iterate
      if right(temp,4)='info' then do
           lasticon = lasticon+1
           parse var temp i.lasticon '.' .
      end  
end
/*
1]   ----------------------------- Set up some variables
*/
cls = d2c(12)
vt  = x2c(9B) || x2c(46)
clr = x2c(9B) || x2c(4B)
IconsCopied = 0
call firstcls
/*
1]   --------------------------------------- Our Main Loop 
*/
call CheckIcon
call Header
do forever
   temp = vt' FileName: 'clr
   ret = writech(stdout,temp)
   parse pull ans
   select
      when ans = '' then do
         leave
      end
      when ans = '?' then do
         call cls 7
         IconType = ""
         call GetType
         call CheckIcon
         call Header
      end
      otherwise do
         cmd = 'copy' dirpath
         if right(cmd,1) ~= ':' then cmd = cmd || '/'
         cmd = cmd || IconType'.info'
         cmd = cmd 'to' ans'.info'
         say vt'--- Attaching Icon to 'ans clr
         cmd = address command '"'cmd'"'
         interpret cmd
         IconsCopied = IconsCopied + 1
      end
   end 
end
call Aus 7      /* Exit Program */

/***************************************************************************

1]                                  SubRoutines

****************************************************************************/

/*
1]   --------------------- Is IconType Valid? 
*/
CheckIcon:
outflag = ""
do forever
   if IconType = "" then call GetType
   if datatype(IconType)='NUM' then IconType = i.IconType
   if datatype(IconType)='CHAR'then do 
      do a = 1 to LastIcon
         if upper(IconType)=upper(i.a) then outflag = 'OK'
      end
   end
   if outflag ~= 'OK' then call GetType;else leave
end
return

/*
1]   --------------------- Get IconType From User
*/
GetType:
   
   say 'Available Icon Models:'
   say ' '

   do a = 1 to LastIcon by 2
     b=a+1
     i1 = right((a')'),4)
     i2 = right((b')'),3)
     say i1 left(i.a,10) ' ' i2 left(i.b,10)
   end

   say ' '
   say ' Enter the number or name'
   temp = ' of the model: '
   ret = writech(stdout,temp)
   parse pull IconType
   if IconType = "" then call aus ((LastIcon+1)/2)+5
   call cls ((LastIcon+1)/2)+5
return

/*
1]   --------------------- Main Loop Header
*/
Header:
   say 'Attach Icon' IconType
   say ' '
   say '  Enter Receiving FileName'
   say '  <return> to exit' 
   say '  <?> for new Icon Type'
   say ' '
   say ' '
return

/*
1]   --------------------- Initialize Area
*/
firstcls:
   say ' '
   say ' =============================='
   do a = 1 to ((lasticon+1)/2)+5
     say '   '
   end
   say vt vt
   call cls lasticon/2+4
return

/*
1]   --------------------- Clear Area
*/
cls:
   arg lines
   do a = 1 to lines
      temp = vt clr
      ret = writech(stdout,temp)
   end
return
/*
1]   --------------------- Graceful Exit
*/
Aus:
   arg lines
   call cls lines
   say 'Icon: Total of' IconsCopied 'Icons Copied.'
   exit