%include "inc:util.imp"
%include "iffinc.imp"

!Little utility turns colour image into Monochrome
!J. Butler Mar 87

%begin
%record (iffhdr fm) iffin, iffout
%owninteger rc,a
%string (255) param, infile, outfile

%routine iff mono(%record (iffhdr fm) %name iffhdr, %integer ad)
   !Turn image into evenly-spaced grey level image
   %real scale
   %integer p,q,r,from,blue,green,red,i,cval,ix
   %byteintegername c
   %integerarray totg,toti,intensity(0:255)

   %for p=0,1,255 %cycle; totg(p)=0;toti(p)=0; %repeat

   %if iffhdr_mapaddr#0 %start ;!There's a map
      scale = 31*31*7
      %for i=0, 1, iffhdr_maplen-1 %cycle
         cval = halfinteger(iffhdr_mapaddr+i<<1)
         blue = (cval>>10)&31; green = (cval>>5)&31; red = cval&31
         intensity(i) = int(255*sqrt((blue*blue + 4*green*green + 2*red*red)/scale))
         !Intensity = weighted R-M-S of gun values (empirical).
         !Scale intensities to 0-255
      %repeat

      ix=a
      %for i=0, 1, iffhdr_ht*iffhdr_wid-1 %cycle
         c==byteinteger(ix)
         totg(c)=totg(c)+1
         c = intensity(c); ix=ix+1
         toti(c)=toti(c)+1
      %repeat

      %for i=0, 1, 255 %cycle
         %if totg(i)#0 %or toti(i)#0 %start
         write(i, 3); printsymbol(':'); write(totg(i), 8); write(toti(i), 8); newline
         %finish
      %repeat
   %finish
%end

%constinteger ibyte=0, iword=1, iboolean=2,    icompress= 16_C0
param = cli param
infile=param %and outfile=param %unless param -> infile.("/").outfile
a=0
rc = iff readin(infile, iffin, a)
!If we opened the file successfully...
printline("IFF connect: ".iff error(rc)) %and %stop %if rc#0

iff show header(iffin, 1)  ;!display it
iff mono(iffin, a)
heapput(iffin_mapaddr) %if iffin_mapaddr#0
iffout=iffin
iffout_mapaddr=0

rc = iff writeout(outfile, iffout, a)
heapput(a)
printline(iff error(rc)) %if rc#0
%endofprogram
