				program adi2col

!				ADI2COL file   (no extension in filename)
!			input file extension must be .PLT
!			output file extension will be .COL
!			Jeff Casey    10/24/90

!			Translates output file from ACAD R10 generic ADI
!			    plotter driver to DEC LJ250 printer format.
!			Printer runs at         X:  180 dots/in, 7.922in
!			                        Y:  180 dots/in, 6.039in
!			Configure ADI driver to X:  390 dots/in, 10.5in
!			                        Y:  390 dots/in, 7.875in
!			       (for consistency with ADI2TEK driver).
!			Don't forget to map pen colors.

!		uses highest resolution (180 dpi) both axes.
!		7 pen capability:  1-red, 2-yellow, 3-green, 4-cyan, 
!			5-blue, 6-magenta, and 7-black.  
!			pen numbers correspond to AutoCAD default.  
!			pen number > 7 is same as 7 (black).


	integer*1 i1
	integer*2 ilen
	integer*4 readx, ready
	character*1 esc
	character*15 f1, f2, f3, file
	logical apen, blank
	integer*2 unit(7), ppen(7)
	integer*1 pixels [huge] (32368,6)    ! 32368 = 136 * 238 lines
	integer*1 chrout, lastchr, pix(816)  ! 816 = one line (136) * 6rows
	common /big/ pixels

	esc  = char(27)

	narg = nargs()				! get input parameters
	if (narg .ne. 2) call error

	call getarg (int2(1),file,ilen)		! get filename
	if (ilen .lt. 1) call error

	f1(1:ilen) = file(1:ilen)		! open input file
	f1(ilen+1:ilen+5) = '.plt'C
	open (1,file=f1,status='old',iostat=ierr,form='binary')
	if (ierr .ne. 0) call error

	iflen = ilen+4
	f2 = f1					! open output file
	f2(ilen+2:ilen+4) = 'col'

	write (*,' ('' Generic ADI Plotfile to DEC LJ250.''/
     +	    '' Translating file:  "'',a,''"  to file  "'',a,''".'')')
     +	              f1(1:iflen), f2(1:iflen)

	open (2,file=f2,status='new',iostat=ierr,form='binary')
	if (ierr .ne. 0) then
	  write (*,*)
	  write (*,'('' Output file "'',a,''" exists.'')') f2(1:iflen)
	  write (*,'('' Hit (CR) to overwrite, (^C) to cancel. '',$)')
	  read (*,*)
	  open (2,file=f2,status='old',iostat=ierr,form='binary')
	  if (ierr .ne. 0) call error
	end if

!           initialize sixel mode in LJ250, and define colors:
!         #1=red, #2=yellow, #3=green, #4=cyan, #5=blue, #6=magenta, #7=black
	write (2) esc,'P9;0;4q#7;1;0;0;100#1;1;135;50;100',
     +	       '#2;1;170;50;100#3;1;240;50;100#4;1;315;50;100',
     +	       '#5;1;15;50;100#6;1;75;50;100'

	apen = .false.
	nx = 0
	ny = 0
	lx = 0
	ly = 0
	lastchr = 45				! initialize w/ LF
	nrept = 1
	ipen = 0
	pixels = 0

	do while (.true.)                       ! read input
	  read (1,iostat=iend) i1               ! read function
	  if (iend .eq. 1) call eof

	  if (i1 .eq. 1) then			! begin plot (single byte)
	    continue

	  else if (i1 .eq. 2) then		! end plot (single byte)
	    exit

	  else if (i1 .eq. 3) then		! move (byte,word,word)
	    apen = .false.			! move, pen up (byte,word,word)
	    lx = readx()
	    ly = ready()

	  else if (i1 .eq. 4) then		! draw (byte,word,word)
	    apen = .true.
	    nx = readx()		! readx,ready do:  read I*2 word,
	    ny = ready()		! correct for unsigned, normalize
	    ndx = iabs(nx-lx)
	    ndy = iabs(ny-ly)
	    nd = max(ndx,ndy)		! number of steps for good resolution
	    if (nd .ne. 0) then
	      dx = (float(nx)-float(lx))/float(nd)
	      dy = (float(ny)-float(ly))/float(nd)
	      do ijk = 0, nd		! here is where vector rasterizes...
	        nx1 = lx + int(float(ijk)*dx+.5)
	        ny1 = ly + int(float(ijk)*dy+.5)
	        call plot(nx1,ny1)
	      end do
	    else			! ...unless it is so short it is a dot.
	      nx1 = nx
	      ny1 = ny
	      call plot(nx1,ny1)
	    end if
	    lx = nx
	    ly = ny

	  else if (i1 .eq. 5) then		! newpen (byte,byte)
	    read (1,iostat=iend) i1               ! read pen value
	    if (iend .eq. 1) call eof
	    if (ipen .ne. 0) then
	      write (*,'('' saving pen '',i2,'' data'')') ipen
	      write (f3,'(''pen'',i1,''.dat'',a1)') ipen,char(0)
	      open (unit=3,file=f3,status='new',iostat=ierr,
     +	               form='binary',blocksize=8192)
	      if (ierr .ne. 0) call error
	      do ll = 1, 238			! write raster map for old pen
	        l0 = 136*(ll-1)			! to temporary datafile
	        write (3) ((pixels(l+l0,j),l=1,136),j=1,6)
	      end do
	      close (3)
	      pixels = 0
	    end if
	    ipen = i1				! and start new pen map
	    write (*,'('' plotting vectors to pixel map, pen '',i2)') ipen

	  else if (i1 .eq. 6) then		! setspeed (byte,byte)
	    read (1,iostat=iend) i1
	    if (iend .eq. 1) call eof

	  else if (i1 .eq. 7) then		! setlinetype (byte byte)
	    read (1,iostat=iend) i1
	    if (iend .eq. 1) call eof

	  else if (i1 .eq. 8) then		! penchange (single byte)
	    continue

	  else if (i1 .eq. 9) then		! abort (single byte)
	    stop 'abort command in ADI file'

	  else
	    write (*,*) 'unknown command in ADI file:  ',i1
	    stop        'abnormal termination.'
	  end if
	end do

	if (ipen .ne. 0) then		! don't forget to save last active pen
	  write (*,'('' saving pen '',i2,'' data'')') ipen
	  write (f3,'(''pen'',i1,''.dat'',a1)') ipen,char(0)
	  open (unit=3,file=f3,status='new',form='binary',blocksize=8192)
	  do ll = 1, 238			! write raster map to file
	    l0 = 136*(ll-1)
	    write (3) ((pixels(l+l0,j),l=1,136),j=1,6)
	  end do
	  close (3)
	end if


	iunit = 10
	npen = 0
	do i = 1, 7				! start output file
	  write (f3,'(''pen'',i1,''.dat'',a1)') i,char(0)
	  open (unit=iunit,file=f3,status='old',iostat=ierr,
     +	                  form='binary',blocksize=8192)
	  if (ierr .eq. 0) then			! found a valid raster map,
	    npen = npen + 1			! this pen is active...
	    unit(npen) = iunit
	    ppen(npen) = i
	    iunit = iunit + 1
	  end if
	end do

	write (*,'('' converting pixel map to sixel string, '',i1,
     +	               '' pen(s) active''/'' '')') npen
	do i = 1, 238				! 238 lines of sixels
	  write (*,'(''+...line '',i3,''/238'')') i
	  call dumpit (int1(45),nrept,lastchr)	! send linefeed
	  do np = 1, npen			! scan through this line for 
	    read (unit(np)) (pix(ij),ij=1,816)		! each pen
	    blank = .true.
	    do j = 1, 816
	      if (pix(j) .ne. 0) then
	        blank = .false.
	        exit
	      end if
	    end do
	    if (blank) cycle			! ignore pen if line blank

	    call dumpit (int1(36),nrept,lastchr)	! send CR
	    call dumpit (int1(35),nrept,lastchr)	! setup new pen
	    call dumpit (int1(ppen(np)+48),nrept,lastchr)
	    call dumpit (int1(63),nrept,lastchr)	! tab over a bit
	    nrept = 80
	    do j = 1, 135		! 136 bytes per line
	      do k = 1, 8		! 8 vertical sixels per byte
	        ik = 1
	        if (k .gt. 1) ik = 2**(k-1)
	        chrout = 63
	        if (iand(pix(    j),ik) .ne. 0) chrout = chrout + 1
	        if (iand(pix(136+j),ik) .ne. 0) chrout = chrout + 2
	        if (iand(pix(272+j),ik) .ne. 0) chrout = chrout + 4
	        if (iand(pix(408+j),ik) .ne. 0) chrout = chrout + 8
	        if (iand(pix(544+j),ik) .ne. 0) chrout = chrout + 16
	        if (iand(pix(680+j),ik) .ne. 0) chrout = chrout + 32
	        if (chrout .eq. lastchr) then
	          nrept = nrept + 1
	        else 
	          call dumpit (chrout,nrept,lastchr) 
	        end if
	      end do
	    end do
	  end do
	end do
	call dumpit (int1(0),nrept,lastchr)
	write (2) esc,'/'

	do i = 1, npen			! sixel mode now off, buffer purged
	  close (unit(i),status='delete')
	end do
	close (1)
	close (2)
	write (*,*) 'done'

	end


	subroutine eof
	write (*,*) '  '
	write (*,*) 'Abnormal termination - unexpected end of file.'
	write (*,*) '  '
	stop
	return
	end

	subroutine error
	write (*,*) '  '
	write (*,*) 'Intended use:  convert an AutoCAD plotter .PLT file'
	write (*,*) 'into a .COL (DEC LJ250 color printer) file.'
	write (*,*) '  '
	write (*,*) 'Configure AutoCAD to Generic ADI driver, ',
     +	                  '180 DPI, 7.922x6.039 in.'
	write (*,*) '  '
	write (*,*) 'Useage:  ADI2COL file'
	write (*,*) '   input file extension must be .PLT'
	write (*,*) '   output file extension will be .COL'
	write (*,*) '  '
	write (*,*) '                   Jeff Casey (last mod 10/24/90)'
	stop ' '
	return
	end

	subroutine plot (nx,ny)
	integer*1 pixels [huge] (32368,6)
	common /big/ pixels
!				convert coordinate to bit in pixel map
	if (nx .lt. 0)    nx = 0
	if (nx .gt. 1426) nx = 1426
	if (ny .lt. 0)    ny = 0
	if (ny .gt. 1087) ny = 1087

	n0 = 1
	if (mod(ny,8) .ne. 0) n0 = 2**mod(ny,8)
	n = ny/8 + (nx/6)*136
	nn = mod(nx,6)
	pixels(n,nn+1) = int1(ior(pixels(n,nn+1),n0))
	return
	end


	subroutine dumpit (chrout,nrept,lastchr)
!		write output format for char CHROUT repeated NREPT times
	logical sigzer			! flag for significant zeros
	integer*1 chrout, lastchr

	if (nrept .gt. 2) then
	  write (2) int1(33)		! repeat code
	  sigzer = .false.
	  if (nrept .gt. 999) then
	    n = nrept/1000
	    nrept = nrept - n*1000
	    write (2) int1(48+n)
	    sigzer = .true.
	  end if
	  if (sigzer .or. (nrept .gt. 99)) then
	    n = nrept/100
	    nrept = nrept - n*100
	    write (2) int1(48+n)
	    sigzer = .true.
	  end if
	  if (sigzer .or. (nrept .gt. 9)) then
	    n = nrept/10
	    nrept = nrept - n*10
	    write (2) int1(48+n)
	  end if
	  write (2) int1(48+nrept)
	else if (nrept .eq. 2) then
	  write (2) int1(lastchr)
	end if
	write (2) int1(lastchr)
	lastchr = chrout
	nrept = 1
	return
	end

	integer*4 function readx ()
	integer*2 i2
	read (1,iostat=iend) i2
	if (iend .eq. 1) call eof
	readx = i2
	if (readx .lt. 0) readx = readx + 64*1024
	readx = int( float(readx)/4095. * 1426. + .5 )
	return
	end

	integer*4 function ready ()
	integer*2 i2
	read (1,iostat=iend) i2
	if (iend .eq. 1) call eof
	ready = i2
	if (ready .lt. 0) ready = ready + 64*1024
	ready = int( float(ready)/3071. * 1087. + .5 )
	return
	end
