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

!Little utility trims black areas off images
!J. Butler Feb 87

%begin
%bytearray colmap(0:511)
%bytearray a(0:512*768-1)
%record (iffhdr fm) iffin, iffout
%owninteger i,j,k,rc,xmin,xmax,ymin,ymax,corner,ip,op,b,ix,xn,xx,yn,yx
%string (255) param

%routine iff trim(%record (iffhdr fm) %name iffh, %integer ad, %c
%integername xmin, xmax, ymin, ymax, corner)
   !Returns coordinates of outermost black row/columns.
   %integer i

  %predicate blackcol(%integer x, ymin, ymax)
     %integer j, ix
     ix = ad+ymin*iffh_wid+x
     %for j=ymin, 1, ymax %cycle
        %false %if byteinteger(ix)#0
        ix=ix+iffh_wid
     %repeat
     %true
  %end

  %predicate blackrow(%integer y, xmin, xmax)
     %integer j, ix
     ix = ad+y*iffh_wid+xmin
     %for j=xmin, 1, xmax %cycle
        %false %if byteinteger(ix) # 0
        ix=ix+1
     %repeat
     %true
  %end

  xmin=0; ymin=0; xmax=iffh_wid-1; ymax=iffh_ht-1
  corner = byteinteger(ad); byteinteger(ad)=0 ;!Locator mark
  %for i=ymin, 1, ymax %cycle
     %exit %unless blackrow(i, xmin, xmax)
     ymin=i     
  %repeat

  %for i=ymax, -1, ymin %cycle
     %exit %unless blackrow(i, xmin, xmax)
     ymax=i
  %repeat

  %for i=xmin, 1, xmax %cycle
     %exit %unless blackcol(i, ymin, ymax)
     xmin=i
  %repeat

  %for i=xmax, -1, xmin %cycle
     %exit %unless blackcol(i, ymin, ymax)
     xmax=i
  %repeat
  byteinteger(ad) = corner
%end

%constinteger ibyte=0, iword=1, iboolean=2,    icompress= 16_C0
param = cli param
rc = iff open file(param, iffin, iff read)
!If we opened the file successfully...
%if rc=0 %start

   iffin_mapaddr = addr(colmap(0))
   rc = iff read header(iffin)   ;!read in the header
   %if rc=0 %start   ;!If we did so successfully...
      iff show header(iffin, 1)  ;!display it
      
      rc = iff read image(iffin, addr(a(0)))  ;!then read the actual image
      
      %if rc=0 %start   ;!If that went OK..
         iff trim(iffin, addr(a(0)), xmin, xmax, ymin, ymax, corner)
         printstring("Image is 0 outside the bounds: ")
         printstring("[".itos(xmin,-1).",".itos(ymin,-1)."]")
         printstring(" and ")
         printstring("[".itos(xmax,-1).",".itos(ymax,-1)."]")
         %if corner#0 %then %c
         printstring(" except for the first pixel")
         newline

         printline("Trim bounds: -1 = maximum")
         prompt("Xmin:"); read(xn); prompt("Xmax:"); read(xx)
         prompt("Ymin:"); read(yn); prompt("Ymax:"); read(yx)
         xn=xmin %if xn<0; xx=xmax %if xx<0
         yn=ymin %if yn<0; yx=ymax %if yx<0

         b = heapget((xx-xn+1)*(yx-yn+1))
         ix=b
         %for i=yn,1,yx %cycle
            %for j=xn,1,xx %cycle
               byteinteger(ix) = a(i*iffin_wid+j); ix=ix+1
            %repeat
         %repeat
         byteinteger(b)=corner %if corner#0
         
      %finishelse printline("IFF read image: ".itos(rc,-1))
   %finishelse printline("IFF read header: ".iff error(rc))
   iff close file(iffin)
%finishelse printline("IFF open file: ".iff error(rc))

%stop %if rc#0

!Now write the trimmed picture back to file
rc = iff open file(param, iffout, iff write)

%if rc=0 %start ;!if we opened it OK..
   !Set up the new header (remember OPENING it will have zapped IFFOUT)
   iffout_hlen=512
   iffout_title = iffin_title
   iffout_wid = xx-xn+1; iffout_ht = yx-yn+1
   iffout_mapaddr = addr(colmap(0))
   iffout_maplen=iffin_maplen; iffout_mapwid=iffin_mapwid
   iffout_datatype = ibyte ! icompress
   rc = iff write header(iffout)
   %if rc=0 %start  ;!we wrote it OK, so..
      i=outstream; selectoutput(0); iff show header(iffout, 1); selectoutput(i)
      rc = iff write image(iffout, b)  ;!write the image..
   %finishelse printline(iff error(rc))
   heapput(b)
   iff close file(iffout) ;!and close down
%finishelse printline(iff error(rc))

%endofprogram
         
   
%routine select region(%integer xoff,yoff,wid,ht, %bytearrayname a)

%integer x0,y0,x1,y1,x2,y2,q,x,y,ox,oy,z,mb, tx, ty


%routine dohline(%integer xb, xt, y)
   %integer i,j,m,n
   %bytearray b(0:ht-1)
   xb=xoff %if xb<xoff; y=yoff %if y<yoff
   xt=tx   %if xt>tx;   y=ty   %if y>ty
!!   colour(line col)
!!   hline(xb, xt, y)
   m = xb-xoff + (y-yoff)*wid
   n = m+xt-xb
   j = 0

   %for i=m, 1, n %cycle
      b(j)=255-a(i); j=j+1
   %repeat
   col fill(xb, y, xt, y, b(0))
%end

%routine dovline(%integer x, yb, yt)
   %integer i,j,m,n
   %bytearray b(0:ht-1)
   x=xoff %if x<xoff; yb=yoff %if yb<yoff
   x=tx   %if x>tx;   yt=ty   %if yt>ty
!!   colour(line col)
!!   vline(x, yb, yt)
   m = x-xoff + (yb-yoff)*wid
   n = x-xoff + (yt-yoff)*wid
   j = 0

{t}write(m, 3); write(n, 3); newline
   %for i=m, wid, n %cycle
      b(j)=255-a(i); j=j+1
   %repeat
   col fill(x, yb, x, yt, b(0))
%end

%routine drawbox(%integer x0,y0,x1,y1)
   dohline(x0,x1,y0)
   dovline(x0,y0,y1)
   dohline(x0,x1,y1)
   dovline(x1,y0,y1)
%end

%routine unhline(%integer xb, xt, y)
   %integer m
   xb=xoff %if xb<xoff; y=yoff %if y<yoff
   xt=tx   %if xt>tx;   y=ty   %if y>ty
   m = xb-xoff + (y-yoff)*wid
   col fill(xb, y, xt, y, a(m))
%end

%routine unvline(%integer x, yb, yt)
   %integer i,j,m,n
   %bytearray b(0:ht-1)
   x=xoff %if x<xoff; yb=yoff %if yb<yoff
   x=tx   %if x>tx;   yt=ty   %if yt>ty
   m = x-xoff + (yb-yoff)*wid
   n = x-xoff + (yt-yoff)*wid
   j = 0

   %for i=m, wid, n %cycle
      b(j)=a(i); j=j+1
   %repeat
   col fill(x, yb, x, yt, b(0))
%end

%routine undrawbox(%integer x0,y0,x1,y1)
   unhline(x0,x1,y0)
   unvline(x0,y0,y1)
   unhline(x0,x1,y1)
   unvline(x1,y0,y1)
%end

%constinteger menul=600, menub=400
%routine mouse functions(%string(10) left,middle,right)

 colour(area col)
 fill(menul-1,menub-3,686,511)
 colour(text col)
 textat(menul+1,496);  showstring("Mouse")
 textat(menul+1,480);  showstring("L: ".left)
 textat(menul+1,464);  showstring("M: ".middle)
 textat(menul+1,448);  showstring("R: ".right)

%end

 %routine monitor
   %integer m
   colour(area col)
   m = x1-xoff + (y1-yoff)*wid
   fill(menul-1,menub-3,686,447)
   colour(text col)
   textat(menul+1, 432); showstring("X:".itos(x, 3))
   textat(menul+1, 416); showstring("Y:".itos(y, 3))
   textat(menul+1, 400); showstring("Z:".itos(a(m), 3))
 %end

 tx = xoff+wid-1; ty = yoff + ht-1

 mouse functions("Quit","Box","Point")

 x2=xoff
 y2=yoff
 ox=mouse x
 oy=mouse y

 %cycle
 x=mouse x
 y=mouse y
 x1=x-ox+xoff
 y1=y-oy+yoff

! Normalise x,y to be within bounds and relative to bottom LH of screen
 %if x1<xoff %start
   x1=xoff
   ox=x
 %else %if x1>tx
   x1=tx
   ox=x-wid
   %if ox<-2048 %then ox=ox+4096
 %finish

 %if y1<yoff %start
   y1=yoff
   oy=y
 %else %if y1>ty
   y1=ty
   oy=y-ht
   %if oy<-2048 %then oy=oy+4096
 %finish

! Now xoff<=x1<=tx and yoff<=y1<=ty
! Write new cursor
 dohline(x1-5,x1+5,y1)
 dovline(x1  ,y1-5,y1+5)

 %if x2#x1 %or y2#y1 %start

! Delete old cursor
 unhline(x2-5,x2+5,y2)
 unvline(x2  ,y2-5,y2+5)

 x2=x1
 y2=y1

 %finish

 mb = mouse buttons

 monitor %if mb & right # 0
 %repeatuntil mb&left # 0 %or mb&middle # 0

 %return %if mb&left # 0

! delete cursor
 unhline(x2-5,x2+5,y2)
 unvline(x2  ,y2-5,y2+5)

! Wait for him to get his fingers off the buttons
 %cycle
 %repeatuntil mouse buttons=0

 mouse functions("Cancel", "Accept", "Corner")

 x0=x1
 y0=y1
 x2=x0
 y2=y0

 %cycle

 x=mouse x
 y=mouse y
 x1=x-ox+xoff
 y1=y-oy+yoff

 %if x1<xoff %start
   x1=xoff
   ox=x
 %else %if x1>tx
   x1=tx
   ox=x-wid
   %if ox<-2048 %then ox=ox+4096
 %finish

 %if y1<yoff %start
   y1=yoff
   oy=y
 %else %if y1>ty
   y1=ty
   oy=y-ht
   %if oy<-2048 %then oy=oy+4096
 %finish

 drawbox(x0,y0,x1,y1)
 
 %if x2#x1 %or y2#y1 %start

 undrawbox(x0,y0,x2,y2)

 x2=x1
 y2=y1

 %finish

 %repeatuntil mouse buttons=4 %and x0#x1 %and y0#y1

 undrawbox(x0,y0,x2,y2)

 printstring("Coords (pixels) are: [")
 write(x0,-1); printsymbol(','); write(y0,-1)
 printstring("] [")
 write(x1,-1); printsymbol(','); write(y1,-1)
 printstring("]"); newline
%end