home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / APPS / CAD / ADIPLT.ZIP / ADI2TEK.FOR < prev    next >
Encoding:
Text File  |  1990-10-24  |  4.2 KB  |  145 lines
  1.                 program adi2tek
  2.  
  3. !                ADI2TEK file   (no extension in filename)
  4. !            input file extension must be .PLT
  5. !            output file extension will be .TEK
  6. !            Jeff Casey    10/24
  7.  
  8. !            Translates output file from ACAD R10 generic ADI
  9. !                plotter driver to Tektronix 12bit format.
  10. !            Configure ADI driver to X:  390 dots/in, 10.5in
  11. !                                    Y:  390 dots/in, 7.875in
  12. !            Don't forget to map pen colors (ignored here).
  13.  
  14.     integer*1 i1
  15.     integer*2 i2, ilen
  16.     character*1 esc, gs
  17.     character*15 f1, f2, file
  18.     logical apen, tpen
  19.  
  20.     esc  = char(27)
  21.     gs   = char(29)
  22.  
  23.     narg = nargs()                ! get input parameters
  24.     if (narg .ne. 2) call error
  25.  
  26.     call getarg (int2(1),file,ilen)        ! get filename
  27.     if (ilen .lt. 1) call error
  28.  
  29.     f1(1:ilen) = file(1:ilen)        ! open input file
  30.     f1(ilen+1:ilen+5) = '.plt'C
  31.     open (1,file=f1,status='old',iostat=ierr,form='binary')
  32.     if (ierr .ne. 0) call error
  33.  
  34.     iflen = ilen+4
  35.     f2 = f1                    ! open output file
  36.     f2(ilen+2:ilen+4) = 'tek'
  37.  
  38.     write (*,' ('' Generic ADI Plotfile to Tektronix translator.''/
  39.      +            '' Translating file:  "'',a,''"  to file  "'',a,''".'')')
  40.      +               f1(1:iflen), f2(1:iflen)
  41.  
  42.     open (2,file=f2,status='new',iostat=ierr,form='binary')
  43.     if (ierr .ne. 0) then
  44.       write (*,*)
  45.       write (*,'('' Output file "'',a,''" exists.'')') f2(1:iflen)
  46.       write (*,'('' Hit (CR) to overwrite, (^C) to cancel. '',$)')
  47.       read (*,*)
  48.       open (2,file=f2,status='old',iostat=ierr,form='binary')
  49.       if (ierr .ne. 0) call error
  50.     end if
  51.  
  52.     write (2) gs            ! initialize TEK, turn on vector mode
  53.     apen = .false.
  54.     tpen = .false.
  55.     nx = 0
  56.     ny = 0
  57.     lx = 0
  58.     ly = 0
  59.  
  60.     do while (.true.)                       ! read input
  61.       read (1,iostat=iend) i1               ! read function
  62.       if (iend .eq. 1) call eof
  63.       if (i1 .eq. 1) then            ! begin plot (single byte)
  64.         continue
  65.       else if (i1 .eq. 2) then        ! end plot (single byte)
  66.         exit
  67.       else if ((i1 .eq. 3) .or. (i1 .eq. 4)) then  ! (move/draw)
  68.         apen = .false.            ! move, pen up      (byte,word,word)
  69.         if (i1 .eq. 4) apen = .true.    ! draw, pen down    (byte,word,word)
  70.         read (1,iostat=iend) i2
  71.         if (iend .eq. 1) call eof
  72.         nx = i2
  73.         if (nx .lt. 0) nx = nx + 64*1024
  74.         read (1,iostat=iend) i2
  75.         if (iend .eq. 1) call eof
  76.         ny = i2
  77.         if (ny .lt. 0) ny = ny + 64*1024
  78.         if (apen .and. .not. tpen) call plot (lx,ly)
  79.         if (tpen .and. .not. apen) write (2) gs
  80.         call plot (nx,ny)
  81.         tpen = .true.
  82.         lx = nx
  83.         ly = ny
  84.       else if (i1 .eq. 5) then        ! newpen (byte,byte)
  85.         read (1,iostat=iend) i1               ! read function
  86.         if (iend .eq. 1) call eof
  87.       else if (i1 .eq. 6) then        ! setspeed (byte,byte)
  88.         read (1,iostat=iend) i1
  89.         if (iend .eq. 1) call eof
  90.       else if (i1 .eq. 7) then        ! setlinetype (byte byte)
  91.         read (1,iostat=iend) i1
  92.         if (iend .eq. 1) call eof
  93.       else if (i1 .eq. 8) then        ! penchange (single byte)
  94.         continue
  95.       else if (i1 .eq. 9) then        ! abort (single byte)
  96.         stop 'abort command in ADI file'
  97.       else
  98.         write (*,*) 'unknown command in ADI file:  ',i1
  99.         stop  'abnormal termination.'
  100.       end if
  101.  
  102.     end do
  103.  
  104.     write (2) esc,'[','!','p'
  105.     end
  106.  
  107.  
  108.     subroutine eof
  109.     write (*,*) '  '
  110.     write (*,*) 'Abnormal termination - unexpected end of file.'
  111.     write (*,*) '  '
  112.     stop
  113.     return
  114.     end
  115.  
  116.     subroutine error
  117.     write (*,*) '  '
  118.     write (*,*) 'Intended use:  convert an AutoCAD plotter .PLT file'
  119.     write (*,*) 'into a .TEK (high density tektronix) file.'
  120.     write (*,*) '  '
  121.     write (*,*) 'Configure AutoCAD to Generic ADI driver, 390 DPI,',
  122.      +                             ' 10.5x7.874 in.'
  123.     write (*,*) '  '
  124.     write (*,*) 'Useage:  ADI2TEK file'
  125.     write (*,*) '   input file extension must be .PLT'
  126.     write (*,*) '   output file extension will be .TEK'
  127.     write (*,*) '  '
  128.     write (*,*) '                   Jeff Casey (last mod 10/24/90)'
  129.     stop ' '
  130.     return
  131.     end
  132.  
  133.     subroutine plot (nx,ny)
  134.     if (nx .lt. 0) nx = 0
  135.     if (ny .lt. 0) ny = 0
  136.     if (nx .gt. 4095) nx = 4095
  137.     if (ny .gt. 3071) ny = 3071
  138.     write (2) int1(ishft(ny,-7)+32),
  139.      +              int1(ishft(iand(ny,3),2)+iand(nx,3)+96),
  140.      +              int1(ishft(iand(ny,124),-2)+96),
  141.      +              int1(ishft(nx,-7)+32),
  142.      +              int1(ishft(iand(nx,124),-2)+64)
  143.     return
  144.     end
  145.