
!*****************************************************************
!*                                                               *
!* HTONE: Display a 3-image (R-G-B) IFF file as a halftone image *
!*                                                               *
!*                  Version 1.1 29 Mar 1988                      *
!*                                                               *
!*****************************************************************

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

%begin
%string (255) infile
%integer ht, wid, rc, max, a, ad, i, c, ix, iy
%halfarray cm(0:511)
%record (iffhdr fm) iffhdr

%routine Set Up
  Offset (0,0)
  enable(16_FF)
%end

%routine Mix Colour (%short Col, Red, Green, Blue)
   CM(Col)=Red+Green<<5+Blue<<10
%end

%routine set rest of map
   %integer r,g,b,v
   v=96
   %for r=0, 1, 4 %cycle
      %for g=0, 1, 4 %cycle
         %for b=0, 1, 4 %cycle
             mix colour(v, r*3, g*3, b*3); v=v+1
         %repeat
      %repeat
   %repeat
   update colour map(cm(0))
%end

%routine transfer(%integer from, to)
   %integer i, j
   %bytename f, t
   f == byteinteger(from); t == byteinteger(to)

   %for i=0, 1, ht-1 %cycle
      %for j=0, 1, wid-1 %cycle
         t = f; t == t[2]; f == f[1]
      %repeat
      t == t[wid+wid]
   %repeat
%end
   
%routine interpolate(%integer ad)
   %integer i,j
   %bytename r,g,b, x

   r == byteinteger(ad); g == r[1]; b == r[wid+wid]; x == b[1]
   %for i=0, 1, ht-1 %cycle
      %for j=0, 1, wid-1 %cycle
          x=((r//7)*5 + ((g-32)//7))*5 + ((b-64)//7) + 96
          r == r[2]; g == g[2]; b == b[2]; x == x[2]
      %repeat
      r == r[wid+wid]; g == r[1]; b == r[wid+wid]; x == b[1]
   %repeat
%end

%routine bulk fill(%integer bytes, %name from, %byte filler)
   !Fill BYTES bytes from FROM with FILLER
   %return %if bytes = 0
f loop:
   *move.b d1, (a0)+
   *subq.l #1, d0
   *bne    f loop
%end

setup
infile = cli param
rc = iff open file(infile, iffhdr, iff read)
printstring("Not a valid IFF file -".iff error(rc)) %and newline %and %return %c
%if rc#0

iffhdr_mapaddr = addr(cm(0))
rc = iff read header(iffhdr)
ht = iffhdr_ht; wid=iffhdr_wid; max=ht*wid
%if rc=0 %start
   iff show header(iffhdr, 0)

   %if iffhdr_maplen=0 %start
      !No colour map - construct grey scale
      %for i=0,1,255 %cycle; c = i>>3; mix colour(i, c, c, c); %repeat
   %finish

   Update Colour Map (cm(0))
   
   Clear


   a = heapget(ht*wid)
   ad = heapget(ht*wid*4)
   rc = iff read image(iffhdr, a)
   iff flip(iffhdr, a)
   transfer(a, ad)
   rc = iff read image(iffhdr, a)
   iff flip(iffhdr, a)
   transfer(a, ad+1)
   rc = iff read image(iffhdr, a)
   iff flip(iffhdr, a)
   transfer(a, ad+wid*2)
   set rest of map
   interpolate(ad) ;!testing

   ix = 344 - wid; iy = 256 - ht
   col fill(ix, iy, ix+wid*2-1, iy+ht*2-1, byteinteger(ad))
%finish
%endofprogram

