%include "inc:util.imp"
%include "level1:graphinc.imp"


!Takes a run-length encoded IFF' file, expands it, rearranges it and displays it.
!This version then allows image to be edited

!Encoding is...
!<char> {<repeat>}   repeated indefinitely
!<char> = 0  encodes as 0, 0
!<char> = 10 encodes as 0, 1
!e.o.f.      encoded as 0, 3
!<repeat>    encoded as 0, <count>, 4<=<count><=127
!            or         0 <count>>8> ! 128, <count>&255

!Header is uncompressed and is 1024 bytes long.  Format is IFF format published
!by Andrew Blake but extended by 512 bytes to include colour map.

!J. Butler Dec 85

%begin
%integer xl,yl,xh,yh
%string (255) param,infile,outfile, gendate,gentime, title
%bytearray a(0:640*768-1)
%integer hlen, wid, ht, junk, magic, type, cval, maplen
%owninteger i,j,k,r,c,cno,b,rl,rtot,d,plen,hptr,junkb
%integer max
%half %array CM (0:255)
%half %name CMp
%integer XOff,YOff,filelen,filstart,filptr,x,y,filend,filmark,rlleft,rlno,no
%byte Maps,Dump

%label eof,cycle,incycle
%bytefn next
!!   filptr=filptr+1 %if byteinteger(filptr)=10
!!   filptr=filptr+1
!!   %result=byteinteger(filptr-1)

   %label nonl

   *MOVEA.L filptr,A0
   *CMP.B  #10,0(A0)
   *BNE     nonl
   *ADDQ.L  #1,filptr
   *ADDQ.L  #1,A0

nonl:
   *ADDQ.L  #1,filptr
   *MOVE.B  0(A0),D0
   *rts

%end

%integerfn get byte
   !Uses globals RLNO, RLLEFT, FILPTR
   !Get the next character.  If it's in the middle of a run, decrement rlleft
   !and return. If it's the start of a new run, grab the new run count and
   !store char in rlno and run length (-1) in rlleft.   Remeber...
   !<char> = 0  encodes as 0, 0
   !<char> = 10 encodes as 0, 1
   !e.o.f.      encoded as 0, 3
   !<repeat>    encoded as 0, <count>, 4<=<count><=127
   !            or         0 <count>>8> ! 128, <count>&255

!!   %integer rl,no,k,filmark
!!   %if rlleft#0 %then rlleft=rlleft-1 %and %result=rlno
!!   no=next
!!   filmark=filptr
!!   %if no = 0 %start
!!      !next char. is 2nd byte of encoded char. or 1st byte K of run length
!!      no=next
!!      %if no=1 %start
!!         no=10
!!         filmark=filptr
!!         k=next
!!      %elseif no=0
!!         filmark=filptr
!!         k=next
!!      %elseif no=3
!!         %result=-1
!!      %else
!!         %signal 15,1 ;!We're in a twist
!!      %finish
!!   %else
!!      k=next
!!   %finish
!!   rl=next
!!   %if k=0 %and rl>=4 %start
!!      %if rl>127 %then rl=(rl&127)<<8+next
!!      rlleft=rl-1; rlno=no; %result=rlno
!!   %else
!!      filptr=filmark
!!      %result=no
!!   %finish

%label nonl1,nonl2,nonl3,nonl6,nonl7
%label noneleft,notone,notzero,notthree,nonzero,nolen,onelen

   *MOVE.L  rlleft,D0    ;!%if rlleft#0 %then rlleft=rlleft-1 %and %result=rlno
   *BEQ     noneleft 
   *SUBQ.L  #1,rlleft
   *MOVE.L  rlno,D0
   *rts

noneleft:
   *clr.l d0
   *movea.l filptr,a0

   *move.b (a0)+,d0
   *cmp.b #10,d0     ;!Get 1st character, ignoring linefeeds.
   *bne nonl1
   *move.b (a0)+,d0
nonl1:

   *MOVEa.L  a0,a1    ;!mark place immediately after it

   *MOVE.L  d0,d0        ;!If it's not zero, go see if a count follows
   *BNE     nonzero 

   !If it is zero, get next character
   *move.b (a0)+,d0
   *cmp.b #10,d0
   *bne nonl2
   *move.b (a0)+,d0
nonl2:

   *CMP.b   #1,d0       ;!Is it 00,01  (encoded LF)?
   *BNE     notone 

   *MOVE.b   #10,d0      ;!Yes.  Set to 10, mark place and look for count
   *MOVEa.L  a0,a1    ;!filmark=filptr
   *BRA     nonzero

notone:
   *MOVE.b  D0,D0        ;!Is it 00,00 (encoded 00)?
   *BNE     notzero 

   *MOVEa.L  a0,a1    ;!Yes. mark place and look for count
   *BRA     nonzero

notzero:
   *CMP.b   #3,D0       ;!Is it 00,03 (eof) ?
   *BNE     notthree 
   *MOVEQ   #-1,D0       ;!Yes. Result = -1.
   *move.l  a0,filptr
   *rts

notthree:
   *MOVE.L   #-2,D0      ;!Funny
   *rts

nonzero:
   *move.b (a0)+,d1
   *cmp.b #10,d1     ;!Get next byte.  Might be 0, leading to count
   *bne nonl3
   *move.b (a0)+,d1
nonl3:

   *MOVE.b  d1,D1        ;!Not 0 so not count.  Backpedal pointer & return
   *bne     nolen

   *clr.l  d2
   *move.b (a0)+,d2
   *cmp.b #10,d2     ;!Get one after that. If true count, will be >=4
   *bne nonl6
   *move.b (a0)+,d2
nonl6:

   *CMP.l   #4,D2       ;! >=4?
   *BLT     nolen        ;!No. Not a length

   *CMP.l   #127,D2
   *BLE     onelen       ;! <=127 = one-byte count.
   *AND.l   #127,d2     ;! > 127 = two-byte count.  And with 127, ..
   *LSL.L   #8,D2        ;!..shift up one byte

   *move.b (a0)+,d2
   *cmp.b #10,d2     ;! and read the bottom byte
   *bne nonl7
   *move.b (a0)+,d2
nonl7:

onelen:
   *SUBQ.L  #1,D2        ;!rlleft=rl-1; rlno=no; %result=rlno
   *MOVE.L  D2,rlleft
   *MOVE.b  d0,rlno
   *move.l a0,filptr    ;!update filptr
   *RTS        
nolen:
   *move.l a1,filptr
   *rts
%end

%routine Set Up
%integer i
%integer zero = 0
  %on 0 %start
    Print String ("Software requires a graphics system")
    Newlines (2)
    %stop
  %finish
  Offset (0,0)
  enable(16_FF)
  Colour (White)
  %for i = 0, 8, 248 %cycle
     Colour Map (i) = zero
     Colour Map (i+1) = 31
     Colour Map (i+2) = 31<<5
     Colour Map (i+3) = 31<<5+31
     Colour Map (i+4) = 31<<10
     Colour Map (i+5) = 31<<10+31
     Colour Map (i+6) = 31<<10+31<<5
     Colour Map (i+7) = 31<<10+31<<5+31
  %repeat
  Set Terminal Mode (Nopage)
%end

%routine Mix Colour (%byte Col, %integer Red, Green, Blue)
   Colour Map(Col)=Red+Green<<5+Blue<<10
%end

%routine rsymbol(%integername i)
   i=byteinteger(filptr); filptr=filptr+1
%end

%routine rshort(%integername i)
   i=byteinteger(filptr)<<8+byteinteger(filptr+1); filptr=filptr+2
%end

%routine rstring(%string (*) %name s, %integer maxlen)
   %integer c
   s=""
   %cycle
      c=byteinteger(filptr); filptr=filptr+1
      %exit %if c=0
      s=s.tostring(c)
   %repeatuntil length(s)=maxlen
%end

!Mouse buttons
%constinteger left=1, middle=2, right=4 ;!Lord knows if these are correct
%constinteger area col=32, text col=128, line col=240

%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

infile=cliparam
infile = infile.".iff" %if exists(infile.".iff")

printline("Reading ".infile."...")
connectfile(infile,0,filstart,filelen); filptr=filstart; filend=filstart+filelen


rshort(hlen);       !1
rshort(type);       !2
rshort(ht);         !3
rshort(wid);        !4
rshort(junk);       !5
rshort(junk);       !6
rshort(junk);       !7
rshort(junk);       !8
rshort(junk);       !9
rshort(junk);       !10
rshort(junk);       !11
rshort(junk);       !12
rshort(junk);       !13
rstring(gendate,8); !14
rstring(gentime,8); !15
rshort(junk);       !16
rshort(junk);       !17
rshort(magic);      !18
rstring(title,255); !19

printstring(title); newline
printstring(gendate."  ".gentime); newline
PrintString ("File is ");Write(wid,0)
PrintString (" pixels wide by ");Write(ht,0)
PrintString (" pixels high.");Newlines(2)


!t!testing:hlen=0; filstart=0; filptr=0; wid=512; ht=512
Setup

%if hlen>512 %start
   %for i=1,1,510-(filptr-filstart) %cycle
      rsymbol(junkb)
   %repeat

   rshort(maplen)

   %for i=0,1,255 %cycle
      rshort(cval); cm(i)<-cval
   %repeat

%else
   printline("No colour map - grey scale assumed")
   %if filptr-filstart#hlen %start
      %for i=1,1,hlen-(filptr-filstart) %cycle
         rsymbol(junkb)
      %repeat
   %finish
   %for i=0,1,255 %cycle; c = i>>3; CM(i) = (c<<5 + c)<<5 + c; %repeat
%finish

CMp == CM(0)
Update Colour Map (CMp)
   
Clear

max=wid*ht
XOff = 0
XOff = (688-Wid)>>1 %if Wid < 688
YOff = 0
YOff = (512-Ht)>>1 %if Ht < 512
x=0; y=0; rlleft=0
   
!t!%for i=0,1,511 %cycle; %for j=0,1,511 %cycle
!t!   a(i*512+j) = (i+j)>>2
!t!%repeat; %repeat
!t!->testing2

%if type&16_c0 # 0 %start
   printline("Expanding file... ")
   printline("Dubious data") %unless filptr-filstart = hlen
   
!!   %cycle
!!   
!!      !Read in the next run
!!   
!!      no = get byte; %exit %if no<0
!!   
!!      !write the run to the array
!!   
!!      !rlleft = run length - 1.  Note bottom bound of cycle is 0 not 1.
!!      %for k=rlleft,-1,0 %cycle
!!          a(x)=no; x=x+1
!!      %repeat
!!      rlleft=0
!!   %repeatuntil filptr>=filend
   
       *clr.l  d3   ;!x.   <=1023
       *MOVEA.L a,a2
cycle:
       *BSR     getbyte    ;!no in d0
       *MOVE.L  D0,d0
       *BLT     eof
       *MOVE.L  rlleft,d2  ;!count <= 15 bits
       *addq.w  #1,d2
   
incycle:
       *MOVE.L  d3,d1
       *MOVE.B  d0,0(a2,d1.L)    ;!a(x+y)=no
   
       *ADD.L   #1,d3     ;!x=x+1

       *subq.w  #1,d2
       *bne     incycle
       *CLR.L   rlleft       ;!rlleft=0
       *bra     cycle        ;!"trusting" loop - relies on EOF in file.
   !%repeatuntil filptr>=filend
eof:

   printline("Displaying")
   ht=512 %if ht>512
testing2:
   col fill(xoff, yoff, xoff+wid-1, yoff+ht-1, a(0))
%else
   %for i=ht-1,-1,0 %cycle
     %for j=0,1,wid-1 %cycle
        a(i*wid+j)=byteinteger(filptr); filptr=filptr+1
     %repeat
   %repeat
   col fill(xoff, yoff, xoff+wid-1, yoff+ht-1, a(0))
%finish

select region(xoff,yoff,wid,ht, a)

%endofprogram
      
   !t!printstring("UnH:"); write(xb,3); write(xt,3); write(y,3); newline
   !t!printstring("UnV:"); write(x,3); write(yb,3); write(yt,3); newline
   !t!printstring("UnD:"); write(x0,3); write(