	program a_laser
	implicit NONE
c
c		R. B. Goldstein		May, 1986
c		program to read an ERI image file and to produce
c		a file suitable to copy to the apple laserprinter
c
	byte buf(512,512)
	integer*4 size
c
	size = 128		!initialize so dont get improper array error
	call imlod_2(buf,size)
	call print_file(buf,size)
	stop 'Normal Termination'
	end
c
	subroutine print_file(buf,size)
	IMPLICIT none
	integer*4 size
	byte buf(size,size)
c
	integer*4 rows_per_strip, segments, ypos, lines_per_seg
	integer*4 rowstart, rowend, points_per_strip, pwidth
	real*4 inch_size,inches_per_strip,in_in
	integer*4 isize,rps(3),is(3)
	integer*4 i,ii,j,copies,in_cop,len
c
	data rps/128,64,32/ 	!rows per strip
	data is/2,4,7/		!hgt and width of printed picture
c
c		determine the rows per strip to send
	if (size .eq. 128) then
	   isize = 1
	else if (size .eq. 256) then
	   isize = 2
	else if (size .eq. 512) then
	   isize = 3
	else
	   stop 'Incorrect SIZE in print_file'
	endif
	rows_per_strip = rps(isize)
	inch_size = is(isize)   !hgt and width of printed picture
c
c		get copies, inch_size (width and hgt in inches)
5	continue
	write(6,110)inch_size
110	format(' Enter size in inches of image <',f4.1,'>: ',$)
	read(5,111)len,in_in
111	format(q,f10.0)
	if (len.ne.0) THEN
	   if(in_in .lt. 8.) THEN
	      inch_size = in_in
	   else
	      write(6,*)' Size must be less than 8 - reenter'
	      goto 5
	   endif
	endif
c
10	continue
	copies = 1
	write(6,113)copies
113	format(' Enter number of copies <',i3,'> : ',$)
	read(5,114)len,in_cop
114	format(q,i)
	if (len .ne. 0) copies = in_cop
c
c
	open(unit=8,file='a_laser.ps',status='NEW',
	1	carriagecontrol='list')
c
	write(*,*)'Writing file'
c
c		initialize the laser. Set the scaling and position on page
	segments = size/rows_per_strip
	lines_per_seg = size/16
	inches_per_strip = inch_size/segments
	points_per_strip = 72*inches_per_strip
	pwidth = 72*inch_size
	write(8,201)
201	format('72 72 translate')
	write(8,202)pwidth, points_per_strip
202	format(2i4,' scale')
c
c
	
	do i = 1,segments
	   rowstart = (i-1)*rows_per_strip + 1
	   rowend = rowstart + rows_per_strip - 1
	   ypos = -(rowstart - 3)
	   if (ypos .gt.0 ) ypos = 0
	   write(8,207)
207	   format(' save')
	   write(8,102)size, rows_per_strip, size, rows_per_strip, ypos
102	   format(2i4,' 8 [',i4,' 0 0 ',i4,' 0 ',i4,' ] {<')
	   do ii = rowstart,rowend
	      write(8,101)((0+zext(buf(j,ii))),j=1,size)
101	      format((<lines_per_seg>(16z2.2/)))
	   enddo
	   write(8,103)
103	   format(/'>} image'/' restore')
	enddo
	write(8,105)copies
105	format('/#copies ',i3,' def')
	write(8,104)
104	format(/'showpage'/'grestore')
	return
	end
c
	
	subroutine get_size_pos(size,posrow,poscol,ip)
	integer*4 size,posrow,poscol,ip
c
c		gets size and position of picture from operator
c
	integer*4 isize(3)
	data isize/512,256,128/
c
c
10	continue
	if(size .ne. 0) goto 17 !if called from over_ride
	write(6,101)
101	format(' Enter size of picture:'/
     1		'     1 - 512x512'/
     2		'     2 - 256x256'/
     3		'     3 - 128x128')
	read(5,102)jsize
102	format(i)
c		filter the input
	if (jsize.lt.1  .or. jsize.gt.3) then
	   type *,' Size must be between 1 and 3'
	   goto 10
	endif
c
	size=isize(jsize)
c
c
17	continue
c		Get the desired position
	posrow=1
	poscol=1
	if(size.eq.512)return
c
c		size=2
20	continue
	if(size.eq.256) then
	   write(6,104),ip
104	   format('    11  |  12'/
     1            '    ----|----'/
     2            '    21  |  22'/
     3            ' Enter posit as a SINGLE 2 digit nmbr <',i2,'>: ',$)
	   read(5,102)ipq
	   if (ipq.ne.0) ip = ipq
	   posrow= ip/10
	   poscol= jmod(ip,10)
	   if ( (posrow.lt.1) .or. (posrow.gt.2) .or. (poscol.lt.1)
     1                   .or. (poscol.gt.2)) then
	        type *, ' Row or column out of range'
	        goto 20
	        endif
	   return
	   endif
c
c		size=3
30	continue
	if (size.ne.128) stop ' get_siz_pos...logic error'
	   write(6,105)ip
105	   format('   11 | 12 | 13 | 14'/
     1		  '   ------------------'/
     2		  '   21 | 22 | 23 | 24'/
     3		  '   ------------------'/
     4  	  '   31 | 32 | 33 | 34'/
     5		  '   -----------------'/
     6		  '   41 | 42 | 43 | 44'/
     7		  ' Enter a SINGLE 2 digit number <',i2,'>: ',$)
	   read(5,102)ipq
	   if (ipq.ne.0) ip = ipq
	   posrow=ip/10
	   poscol=jmod(ip,10)
	   if ( (posrow.lt.1) .or. (posrow.gt.4) .or. (poscol.lt.1)
     1			.or. (poscol.gt. 4) ) then
	           type *,' Row or column out of range'
	           goto 30
	           endif
	return
	end
c
	subroutine open_head(error,header,headfile)
	character headfile*35
	integer*2 header(256)
	logical error
c
c		Opens and reads the header file of an image
c		Current header format is an ascii file  
c			line   format		variable
c			1	I4		size (128,256,512)
c			2	I2		posrow
c			3	I2		poscol
c			4	I2		0=pixel form, 1=word form
c
	open(unit=1, name=headfile, 
     1		access='SEQUENTIAL', status='OLD', err=900)
	read(1,102)(header(i),i=1,4)
102	format(i4/i2/i2/i2)
	close(unit=1)
c	write(6,101)headfile
101	format(x,a35,' opened ok')
	error = .false.
	return
c
900	continue
	error=.true.
	write(6,103)headfile
103	format(x,a35,' not found')
	return
	end
c
	subroutine over_ride(size,posrow,poscol,header)
c
c		allows operator to override default size and
c		position of where image is placed on the adage
c
	integer*4 posrow,poscol,size
	integer*2 header(256)
	logical error
	integer*2 isize,row,col,ptype
c
c
	integer*4 ip
c
	size = header(1)
	row = header(2)
	col = header(3)
	ip = row*10 + col
	call get_size_pos(size,posrow,poscol,ip)
	return
	end
c
	subroutine pixload_2(image,size,posrow,poscol,stype)
c
c		reads image from disk . Does not send to adage
c		only for pixel formatted images
c
	integer*4 size,posrow,poscol,nblocks,stype
	byte image(512,size)
	integer*4 image4(512)	!a line of image converted to i*4 words
	integer*4 x,y,row,indx
c
c
	nblocks=(size*size)/512
c
c		read image from disk - one block per record
	if (stype.eq.0) then
	   do i=1,nblocks
	      read(3) (image(j,i),j=1,512)
c	      type *,' read block ',i,'  image(1,i) ',image(1,i)
	   enddo
	else		!stype must be 2 - one giant read stmt
	   read(3)image	!512x512 requires differnt read - dont know why
	endif
c
	return
	end
c
	subroutine imlod_2(buf,retsize)
	integer*4 retsize
	byte buf(1,1)
c
c		Modification History:
c			December, 1984		Use header file (RBG)
c			May, 1985  Just loads, doesn't display.
c
c		R. B. Goldstein		September, 1984
c		Loads images of different sizes from disk
c
c		Adopted from imlod by Larry Arend
c		Outline:
c			Get file name,size and desired position
c			Read the file from disk
c			Load it into the adage
c
	character filename*35
	integer*4 size		!size of image 128,256,512
	integer*4 posrow,poscol	!position to put image 11,12,13,14,21,etc.
	integer*4 nblocks	!number of blocks on disk f(size)
	integer*4 indx		!indx into linear array
	integer*4 row		!loop control variable. row number
	integer*4 x,y		!adage coordinates (pixel)
	integer*2 header(256)	!one-block header file
	logical error		!flag for no header file
	integer*4 ip		!combined row-column integer
	character headfile*35	!name of header file
	integer*4 stype		!header(4) - storage type
c
c
c
c
c		get datafile name and open the data file
3	continue
	write(6,101)
101	format(' Enter first name of image file <pix:><.dat>: ',$)
	read(5,102)lenf,filename
102	format(q,a)
	if(lenf.eq.0) then
	   type *, ' No image loaded'
	   return
	endif
	inddot = index(filename,'.')
	indcol = index(filename,':')
	if (index(filename,'.').eq.0) filename=filename(1:15)//'.dat'
	if (index(filename,':').eq.0) filename='pix:'//filename
	inddat = index(filename,'.dat')
	headfile = filename(1:inddat)//'phd'
c
	open(unit=3,name=filename,form='UNFORMATTED',
     1		access='SEQUENTIAL',status='OLD',err=900)
c
c
c		get file size and position to put picture
	call open_head(error,header,headfile)
	size = 0
	ip = 11
	if (error) then	          !get size,pos from operator
		call get_size_pos(size,posrow,poscol,ip)
	else
		size = header(1)
	endif
c
	stype = header(4)
	if( (stype.eq.0) .or. (stype.eq.2) ) then  !pixel or word format?
		call pixload_2(buf, size, posrow, poscol, stype)
	else 
		write(6,110)
110	        format(' Word images cannot be mapped..no load done')
	endif
c
c
	close(unit=3)
	retsize=size
	return
c
c
900	continue
	stop ' Error in opening image file'
	end
