!****************************************************************
!*                                                              *
!*      ANALYSE:    Program analyses JHB-modded IFF files       *
!*                                                              *
!*                  Version 1.3   16 Feb 1987                   *
!*                                                              *
!****************************************************************

%include "inc:util.imp"
{%include "src:util.imp} {FS-D}
%include "iff:iffinc.imp"
{%include "demo:iff:iffinc.imp} {FS-D}
%include "level1:graphinc.imp"
%external%real%fn%spec LOG(%real x)

%begin
%record (iffhdr fm) iffhdr
%halfarray map(0:511)
%integerarray tot(0:255)
%owninteger i,k,l,rc,max,a,img,textcol,mx

%predicate graphics present
   %on 0 %start
      %false
   %finish
   plot(0,0)
   %true
%end

%integerfn best text colour
   %integer i,max, squ, maxsqu, r, g, b
   !Use brightest colour
   max=-1; maxsqu=-1
   %for i=0, 1, 255 %cycle
      r=map(i)>>10&31
      g=map(i)>>5&31
      b=map(i)&31
      squ=r*r+g*g+b*b
      max=i %and maxsqu=squ %if squ>maxsqu
   %repeat
   %result=max
%end

%constinteger panelsize=24
%routine display map
   %integer i,j,c,x,y
   %if iffhdr_maplen=0 %start
      !No colour map - construct grey scale
      %for i=0,1,255 %cycle; c = i>>3; map(i) = (c<<5 + c)<<5 + c; %repeat
   %finish
   update colour map(map(0))
   textcol = best text colour

   clear

   %for x=0,1,15 %cycle
     %for y=0,1,15 %cycle
         i=x*32
         j=y*32+4
         colour (x*16+y)
         fill(i,j,i+panelsize,j+panelsize)
         colour(255-(x*16+y)); textat(i+2, j+2); shex2(x*16+y)
         colour (textcol)
         hline (i,i+panelsize,j)
         hline (i,i+panelsize,j+panelsize)
         vline (i,j,j+panelsize)
         vline (i+panelsize,j,j+panelsize)
     %repeat
   %repeat

   %for y=0,1,255 %cycle
     colour(y)
     fill(608,y*2,683,y*2+2)
   %repeat

   colour(textcol)
   %for y=0,1,15 %cycle
     hline(684,687,y*32)
   %repeat
   vline(687,0,511)
%end

%routine countfile(%integer from, size, datatype)
   %integer p,q,r,max,t0,t1
   %constbytearray hex(0:15) = %c
   '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
   %integerarray wid(0:15)
   %recordformat rf(%real r)
   %record (rf) %name rp

   %routine totup 01s(%integer val, weight, %integername t0, t1)
      %integer i, bits
      bits=0
      %for i=0, 1, 7 %cycle; bits=bits+1 %if val & (1<<i) # 0; %repeat
      t1 = t1 + bits * weight
      t0 = t0 + (8-bits) * weight
   %end

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

   %if datatype=0 %start ;!Bytes
      %for q=from, 1, from+size-1 %cycle
         p = byteinteger(q); tot(p) = tot(p) + 1
      %repeat
   %elseif datatype=1 ;!16-bit word
      %for q=from, 2, from+size-2 %cycle
         p = halfinteger(q); tot(p>>8) = tot(p>>8) + 1
      %repeat         
   %elseif datatype=2 ;!Packed booleans
      %for q=from, 1, from+size-1 %cycle
         p = byteinteger(q); tot(p) = tot(p) + 1
      %repeat
      t0=0; t1=0
      %for q = 0, 1, 255 %cycle
         totup 01s(q, tot(q), t0, t1)
         tot(q)=0
      %repeat
      tot(0) = t0; tot(1) = t1
   %elseif datatype=4 ;!32-bit word
      %for q=from, 4, from+size-4 %cycle
         p = integer(q); tot(p>>24) = tot(p>>24) + 1
      %repeat
   %elseif datatype=5 ;!32-bit real
      %for q=from, 4, from+size-4 %cycle
         rp == record(q); p = int(rp_r); tot(p>>24) = tot(p>>24) + 1
      %repeat
   %finish

   max=0
   %for q=0,1,15 %cycle; wid(q)=0; %repeat
   %for p=0,1,15 %cycle
      %for q=0,1,15 %cycle; wid(q)=tot(p*16+q) %if tot(p*16+q)>wid(q); %repeat
   %repeat
   %for q=0,1,15 %cycle
      p=0; r=1
      p=p+1 %and r=r*10 %while r-1<wid(q)
      %if p>2 %then wid(q)=p %else wid(q)=2
   %repeat
   newline; spaces(3)
   %for p=0,1,15 %cycle; spaces(wid(p)-1); printsymbol('-'); printsymbol(hex(p)); %repeat
   newlines(2)
   %for p=0,1,15 %cycle
      printsymbol(hex(p)); printsymbol('-'); space
      %for q=0,1,15 %cycle; write(tot(p*16+q), -(wid(q)+1)); %repeat
      newline
   %repeat
%end

rc = iff open file(cli param, iffhdr, iff read)
%if rc=0 %start

   iffhdr_mapaddr = addr(map(0))
   rc = iff read header(iffhdr)
   %if rc=0 %start
      max = iffhdr_ht * iffhdr_wid
      max = max*2 %if iffhdr_datatype & 7 = 1 ;!16-bit words
      max = max//8 %if iffhdr_datatype & 7 = 2 ;!Packed booleans
      max = max*4 %if iffhdr_datatype & 7 = 4 %or iffhdr_datatype & 7 = 5 ;!32
      iff show header(iffhdr, 1)
      newlines(2)
      
      a = heapget(max)
      %for img=0,1,iffhdr_stereo %cycle
         rc = iff read image(iffhdr, a)
         %if rc#0 %start
            printline("Data end condition ".itos(rc,-1))
            %if rc # -1 %then %stop
         %finish
         
         set terminal mode(8)
         printstring("Image ".itos(img,-1).":"); newline
         printstring("Grey level distribution:")
         printstring(" (adjusted to 0-255)") %if iffhdr_datatype&7#0
         newline
         countfile(a, max, iffhdr_datatype & 7)
!!         k=0; l=0
!!         %for i=0,1,max-1 %cycle
!!            phex2(byteinteger(a+i)); k=k+1; l=l+1
!!            %if k=24 %then k=0 %and newline %else space
!!            %if l= iffhdr_wid %then newlines(2) %and l=0 %and k=0
!!         %repeat
         %if graphics present %start
            display map
            colour(textcol)
            !Grey level histogram.  Bars for values 0 and 255 may be 512
            !pixels long, rest may be 64.
            !Scale the values so we actually see something
            %for i=0,1,255 %cycle
               %if tot(i)#0 %then tot(i) = int(log(tot(i))*1024)
            %repeat
            mx=-1
            mx=tot(0)//8 %if tot(0)//8>mx
            %for i=1,1,254 %cycle; mx=tot(i) %if tot(i)>mx; %repeat
            mx=tot(255)//8 %if tot(255)//8>mx

            %for i=0,1,255 %cycle
               k=604-(tot(i)*64//mx)
               fill(k,i*2, 604, i*2+1)
            %repeat
   
         %finish
         newlines(2)
      %repeat
   %finishelse printline(iff error(rc))
   iff close file(iffhdr)
%finishelse printline(iff error(rc))
%endofprogram