!J. Butler 25 Nov 85
%include "fractl:iffutils"
!Run-length encoder.  Takes PR-style Mandelbrot bitmap, constructs a header
!and compresses it.   Correct header length (words) 11/86

%begin
%record (iffhdr fm) iffhdr
%constinteger ibyte=0, iword=1, iboolean=2,    icompress= 16_C0
%string (255) param, infile, outfile
%integer c,ct,ina,inl,i,j,k,rl,lastc,hptr,rowbase,inbase,inptr,offset,mode,max

%integer filptr, filstart, filend
%shortarray colmap(0:255)

%routine printch(%integer i); printsymbol(i); %end

%routine pchar(%integer char, count)
   %integer i

   %routine pch(%integer char)
      %if char=0 %start
         printch(0); ct=ct+1
      %finishelseif char=10 %start
         printch(0); char=1; ct=ct+1
      %finish
      printch(char); ct=ct+1
   %end

   %routine prl(%integer count)
      pch(char)
      %if count=1 %start
         !No action
      %finishelseif count<4 %start
         %for i=1,1,count-1 %cycle; pch(char); %repeat
      %finishelseif count<=127 %start
         %if count=10 %then pch(char) %and count=count-1
         printch(0); printch(count); ct=ct+2
      %finishelsestart
         %if count&255=10 %then pch(char) %and count=count-1
         printch(0); printch((count>>8)!16_80); printch(count); ct=ct+3
      %finish
   %end

   %while count > 16_7FFF %cycle
      prl(16_7FFF); count=count - 16_7FFF
   %repeat
   prl(count) %if count # 0
      
   %if ct>=256 %then newline %and ct=0
%end

%routine gettext(%string (31) promptext, %string (*) %name text)
   %string (255) yn
   %cycle
      prompt(promptext.":"); readline(text)
      prompt("OK? Y/N:"); readline(yn)
   %repeatuntil charno(yn,1) & 16_5F = 'Y'
   prompt(":")
%end

%shortintegerfn colword(%integer Red, Green, Blue)
   %result=Red+Green<<5+Blue<<10
%end

param=cliparam
printstring("Parameters?") %and %return %unless %c
param -> infile.(",").outfile %or param -> infile.("/").outfile

ct=0
rl=1

connectfile(infile, 0, ina, inl)
filstart=ina; filptr=filstart; filend=filstart+inl

printline("Format is ".%c
"(B)itmap/(L)UCAS/(P).Reid/(W)INSOM-IFF/(F)unny WINSOM/WINSOM .(I)MG?")
prompt("b/l/p/w/i:")
%cycle; readsymbol(i); mode=i&16_5f
%repeatuntil %c
mode='W' %or mode='B' %or mode='L' %or mode='P' %or mode = 'F' %or %c
mode = 'I'
skipsymbol %while nextsymbol #nl; skipsymbol

iffhdr=0
%for i=0,1,255 %cycle; c=i>>3; colmap(i) = (c<<5 + c)<<5 + c; %repeat
iffhdr_maplen = 256; iffhdr_mapwid = 16

%if mode='P' %start
   iffhdr_wid=shortinteger(ina) ;!Width
   iffhdr_ht=shortinteger(ina+2) ;!Height
   iffhdr_mapaddr = ina+4;!Colour map
   offset=512

%elseif mode='W' ;!True WINSOM output (IFF). Incorporates JHB extensions
   
   iff read header(ina, iffhdr)
   offset = iffhdr_hlen * 2 ;!Convert to bytes

   %if iffhdr_mapaddr # 0 %start
      printline("Funny map length ".itos(iffhdr_maplen,-1)) %and %c
      iffhdr_maplen=256 %if iffhdr_maplen#256 %and iffhdr_maplen#0
      printline("Funny map width  ".itos(iffhdr_mapwid,-1)) %and %c
      iffhdr_mapwid=16  %if iffhdr_mapwid#16 %and iffhdr_mapwid#0
      iffhdr_mapaddr = ina+512
      %for i=0,1,iffhdr_maplen-1 %cycle
         -> notsame %if byteinteger(iffhdr_mapaddr+i)#colmap(i)
      %repeat
      printline("Map is actually a grey scale"); iffhdr_mapaddr=0
notsame:

   %else
      printline("No colour map - grey scale assumed")
   %finish

   printstring(iffhdr_title); newline
   printstring(iffhdr_date."  ".iffhdr_time); newline
   
%elseif mode = 'F'
   iffhdr_wid = byteinteger(ina+7)<<8+byteinteger(ina+6)
   iffhdr_ht = byteinteger(ina+5)<<8+byteinteger(ina+4)
%else
   prompt("wid:"); read(iffhdr_wid)
   prompt("ht:"); read(iffhdr_ht)
   offset=0
   %if mode = 'L' %start
      iffhdr_mapaddr = ina ;!Colour map
      offset=512
   %elseif mode = 'I'
   %else
      %for i = 1,1,7 %cycle
         k = 32*(i-1)
         colmap(k+j)=colword((i&1)*j, (i&2)>>1*j, (i&4)>>2*j) %for j = 0,1,31
         iffhdr_mapaddr = addr(colmap(0))
      %repeat
   %finish
%finish

printstring("File is "); write(iffhdr_wid, 3)
printstring(" * "); write(iffhdr_ht, 3); printstring(" pixels")
newline
gettext("Description", iffhdr_title) %if iffhdr_title=""
iffhdr_time=time; iffhdr_time=iffhdr_time.":00" %if length(iffhdr_time)=5
%stop %unless length(iffhdr_time)=8

openoutput(2, outfile); selectoutput(2)

iffhdr_hlen=0 ;!Not fussy
iffhdr_type = ibyte ! icompress
iff write header(iffhdr)
                                    !    Image. Rasters down from top left

inbase=ina+offset
inptr=0
max=iffhdr_ht*iffhdr_wid
lastc=-1
%if mode = 'L' %start ;!Scans horizontal rasters upwards
   rowbase=max-iffhdr_wid; inptr=0
   %for i=offset,1,inl-1 %cycle
      c = byteinteger(inbase+rowbase+inptr); inptr=inptr+1
      %if inptr>=max %then inptr=0 %and rowbase=rowbase-iffhdr_wid
      %if c=lastc %then rl=rl+1 %elsestart
         pchar(lastc,rl)
         rl=1; lastc=c
      %finish
   %repeat

%elseif mode = 'W' %or mode='F' %or mode = 'I';!Scans horizontal rasters downwards
   %for i=offset,1,inl-1 %cycle
      c = byteinteger(inbase+inptr); inptr=inptr+1
      %if c=lastc %then rl=rl+1 %elsestart
         pchar(lastc,rl)
         rl=1; lastc=c
      %finish
   %repeat

%else ;!Scans vertical rasters left->right
   !WRONG
   inptr=max
   %for i=offset,1,inl-1 %cycle
      c = byteinteger(inbase+inptr); inptr=inptr-iffhdr_wid
      %if inptr<=0 %then inptr=inptr+max+1
      %if c=lastc %then rl=rl+1 %elsestart
         pchar(lastc,rl)
         rl=1; lastc=c
      %finish
   %repeat

%finish

%if rl>0 %then pchar(c,rl)
printch(0); printch(3)
newline
closeoutput

%end

%endoffile