home *** CD-ROM | disk | FTP | other *** search
- Date: Sat, 13 Feb 88 09:57:28 PST
- From: MFENET%MIT.MFENET@NMFECC.ARPA
- Subject: NERUS::CASEY@MIT.MFENET
- To: HICKS@WALKER-EMH.ARPA
-
- NOTE: TO RESPOND TO THIS MESSAGE, PUT THE USERNAME INTO THE SUBJECT LINE.
-
-
- 2/13/88
- Hi -
-
- This is the source code for CAL2TEK. I had put the whole thing
- together into an ARC file with an executable, but I don't know how to send
- a bit file over ARPAnet mail. If you want it, let me know how to send it,
- or if you're really desperate, I could mail you a disk. Otherwise, these
- are the three other files that I included in the ARC. 1st is the DOC file,
- 2nd the FORTRAN source (MS version 4, although it should work with version 3),
- 3rd the MASM source for the subroutine -- it really isn't necessary, but
- allows grabbing the filename as a parameter in the DOS command line. You
- could always eliminate the assembly routine and add a query in the FORTRAN
- source, but that isn't professional, and it wouldn't be my code.
-
- I emphasize that this is an implementation that was hacked for my
- immediate needs, and has now been tested on only two other implementations,
- so you may find bugs -- PLEASE let me know of them.
-
- I also just wrote a similar utility that replaces the PRTSCRN function
- with a HERCULES to LN03+ conversion (dumping a file that prints in sixel
- format). Note that this has only the pixel resolution inherent in the
- HERC screen, while CAL2TEK plots vectors to the LN03+ printer. As a
- comparison, you can PLOT with AutoCAD, convert and print using CAL2TEK, and
- get a very sexy, publication quality plot. You can also capture the screen
- with HERCLN3 while running AutoCAD, and plot it on the same printer, and it
- looks like a crude draft - i.e. a photograph of the screen. I'm not satisfied
- that all the bugs are out of HERCLN3 yet, so if I send it to you, I'd rather
- it didn't propagate until I'm happy with it. Also, I'm not anxious to send
- out the source code for it -- I'm dangling it as bait to get some shareware $$
- back to me. You can have the source if you're willing to experiment and
- feed back comments. Go ahead and propagate CAL2TEK anywhere.
-
- enjoy!
- Jeff Casey
- (617)861-1752 home
- (617)253-0885 work
-
- ----------------- CAL2TEK.DOC ---------------------
-
- Version 1.1
- 1/19/88
- CAL2TEK
-
-
- PURPOSE:
- Transform CALCOMP 81 format (such as produced by AutoCAD)
- into a format printable on a DEC LN03+ laserprinter (via uploading
- from IBM PC compatible to local mainframe such as a VAX).
-
-
- USE:
- CAL2TEK followed by the filename (type .PLT assumed) and
- an optional qualifier (/B) for thicker (bold) linewidths.
- Example:
-
- CAL2TEK plan /b
-
- converts PLAN.PLT to PLAN.TEK, with thicker linewidths on.
- PLAN.PLT is unaffected. PLAN.TEK can be uploaded to a mainframe
- and plotted on an LN03.
-
-
- OTHER NOTES:
- This program is a quick kludge for a specific need of the author.
- It has been tested on only one implementation. The source code
- is included, so that modifications may be made for other setups.
- Only the pen up, pen down, and plot commands were translated,
- as a complete definition of the CALCOMP instruction set was not
- available. I would appreciate any comments, improvements, or changes.
- If you distribute this to other parties, however, please only
- distribute the original version complete with all source files
- and this notice.
-
- CAL2TEK was compiled with Microsoft Fortran V4.00. The subroutine
- GETPAR was assembled with IBM/Microsoft Macro Assembler V2.00. CAL2TEK
- was linked with Microsoft Linker V3.55.
-
- The LN03 offers improved resolution over the TEKTRONIX graphics
- format, which has been incorporated here. If this program is used
- for a TEK graphics device that does not support this feature, the
- two lines of code sending the "extra byte" can be commented out,
- (as noted in the source code) and it should(!) work properly.
-
-
- SHAREWARE NOTICE:
- This software is distributed free of charge. If you use it,
- you were probably in as big a bind as the author, and you will
- be overjoyed to support the shareware philosophy by sending your
- contributions to the address below. Contributions of $25 or more
- will entitle you to free upgrades of future versions, and a
- TSR (terminate & stay resident) PRTSCRN replacement that will
- convert Hercules format graphics to LN03 output that will be
- written in the near future.
-
- COPYRIGHT/LICENSE/WARRANTY:
- This document, and the current version of the source code
- files CAL2TEK.FOR and GETPAR.ASM are copyrighted by the author.
- The copyright owner hereby licenses you to: use the software;
- make as many copies of the program and documentation as you wish;
- give such copies to anyone; and distribute the software and
- documentation via electronic means.
-
- However, you are specifically prohibited from charging, or
- requesting donations, for any such copies, however made. An
- exception is granted to recognized not-for-profit user's groups
- which are authorized to charge a small fee for materials, handling,
- postage, and general overhead. NO FOR-PROFIT ORGANIZATION IS
- AUTHORIZED TO CHARGE ANY AMOUNT FOR DISTRIBUTION OF COPIES OF THE
- SOFTWARE OR DOCUMENTATION.
-
- No copy of the software may be distributed or given away without
- this document; and this notice must not be removed.
-
- There is no warranty of any kind, and the copyright owner is not
- liable for damages of any kind. By using the software, you
- agree to this.
-
- The software and documentation are:
-
- Copyright (c) 1988 by
- Jeffrey A. Casey
- 782 Massachusetts Ave.
- Lexington, MA 02173
- (617)861-1752
-
- -------------------- CAL2TEK.FOR ----------------------------
-
- $storage:2
- program cal2tek
- c
- c version 1.1 1/19/88
- C
- C TRANSFORMS AutoCAD OUTPUT FOR CALCOMP 81 PLOTTER
- C INTO DEC LN03 (TEKTRONIX) FORMAT
- c
- c supports drawing on 2752x1687 field, to tek
- c 4096x3072 field; pen up, pen down commands.
- c ignores all else. can set entire plot to
- c thicker linewidth with /bold option.
- c
- c CAL2TEK file [/bold]
- c looks for file.PLT as input, translates
- c to tektronix format, and writes file.TEK
- c
- c This software copyrighted by the author.
- c The copyright owner hereby licenses you to: use the software;
- c make as many copies of the program and documentation as you wish;
- c give such copies to anyone; and distribute the software and
- c documentation via electronic means.
- c
- c However, you are specifically prohibited from charging, or
- c requesting donations, for any such copies, however made. An
- c exception is granted to recognized not-for-profit user's
- c groups, which are authorized to charge a small fee for
- c materials, handling, postage, and general
- c overhead. NO FOR-PROFIT ORGANIZATION IS AUTHORIZED TO CHARGE
- c ANY AMOUNT FOR DISTRIBUTION OF COPIES OF THE SOFTWARE OR
- c DOCUMENTATION.
- c
- c No copy of the software may be distributed or given away without
- c the accompanying document; and this notice must not be removed.
- c
- c There is no warranty of any kind, and the copyright owner is not
- c liable for damages of any kind. By using the software, you
- c agree to this.
- c
- c The software and documentation are:
- c
- c Copyright (c) 1988 by
- c Jeffrey A. Casey
- c 782 Massachusetts Ave.
- c Lexington, MA 02173
- c (617)861-1752
- c
- c
- c
- C
- integer nx, ny, lx, ly
- integer*1 out(200)
- character*1 line(1024), file1(15), file2(15), msg(15)
- character*15 f1,f2
- equivalence (file1(1),f1), (file2(1),f2)
- logical sp, cpen, tpen, eof, bold
- common out, iout, lx, ly
- C
- C GET INPUT PARAMETERS (FILE NAMES)
- bold = .false.
- call getpar (n,50,line)
- if (n .lt. 2) goto 9998
- ifile = 0
- len1 = 0
- do 10 i = 1, n
- sp = .false.
- if ((line(i) .eq. ' ') .or. (line(i) .eq. ',')
- + .or. (line(i) .eq. '-') .or. (line(i) .eq. '/')
- + .or. (line(i) .eq. '.')) sp = .true.
- if (ifile .eq. 0) then
- if (.not. sp) then
- ifile = 1
- len1 = 1
- file1(1) = line(i)
- end if
- else if (ifile .eq. 1) then
- if (sp) then
- ifile = 2
- else
- len1 = len1 + 1
- file1(len1) = line(i)
- end if
- else
- if ((line(i) .eq. 'b') .or. (line(i) .eq. 'B'))
- + bold = .true.
- end if
- 10 continue
- if (len1 .eq. 0) goto 9998
- C
- 15 file1(len1+1) = '.'
- file1(len1+2) = 'p'
- file1(len1+3) = 'l'
- file1(len1+4) = 't'
- file1(len1+5) = char(0)
- do 16 i = 1, len1+5
- file2(i) = file1(i)
- 16 continue
- file2(len1+2) = 't'
- file2(len1+3) = 'e'
- file2(len1+4) = 'k'
- open (1,file=f1,status='old',err=9998,form='binary')
- open (2,file=f2,status='new',err=9998,form='binary')
- C
- C INITIALIZE TEKTRONIX MODE IN ln03
- C TURN ON GRAPHICS MODE
- if (bold) then
- write (2) char(27), '[','?','3','8','h', char(27),
- + 'h', char(29)
- else
- write (2) char(27), '[','?','3','8','h', char(29)
- end if
- iout = 0
- imsg = 0
- cpen = .false.
- tpen = .false.
- eof = .false.
- nx = 0
- ny = 0
- lx = 0
- ly = 0
- nstate = 0
- C
- C INITIALIZE INPUT LINE, READ (APPENDED)
- 100 ii = 1
- do 110 i = 1, 1024
- line(i) = char(0)
- 110 continue
- read (1,end=1000) (line(i),i=1,1024)
- C
- C PROCESS NEXT CHARACTER
- 200 if (line(ii) .ne. ';') then
- C
- C ADD TO MESSAGE
- if ((line(ii) .ge. '0') .and. (line(ii) .le. '9')) then
- C
- C NUMERAL - PROCESS NUMBER
- if (nstate .eq. 1) then
- C APPEND TO EXISTING x
- if (nxx .ge. 4) then
- write (*,*) 'abort - X > 9999 found'
- stop
- end if
- nxx = nxx + 1
- nxt = 10*nxt + ichar(line(ii))-48
- else if (nstate .eq. 3) then
- C APPEND TO EXISTING y
- if (nyy .ge. 4) then
- write (*,*) 'abort - Y > 9999 found'
- stop
- end if
- nyy = nyy + 1
- nyt = 10*nyt + ichar(line(ii))-48
- else if (nstate .eq. 0) then
- C INITIALIZE x
- nxx = 1
- nxt = ichar(line(ii))-48
- nstate = 1
- else if (nstate .eq. 2) then
- C INITIALIZE y
- nyy = 1
- nyt = ichar(line(ii))-48
- nstate = 3
- else
- C IMPOSSIBLE
- write (*,*) 'abort - apparent 3 parameter entry'
- stop
- end if
- else
- C NOT NUMERAL ENTRY
- if (nstate .eq. 1) then
- C IN x STATE
- lx = nx
- nx = nxt
- nstate = 2
- else if (nstate .eq. 3) then
- C IN y STATE
- ly = ny
- ny = nyt
- nstate = 4
- end if
- imsg = imsg + 1
- msg(imsg) = line(ii)
- end if
- else
- C THIS IS A COMMAND END ';'
- if ((imsg .eq. 1) .and. (msg(1) .eq. 'H')) then
- C PEN UP
- cpen = .false.
- else if ((imsg .eq. 1) .and. (msg(1) .eq. 'I')) then
- C PEN DOWN
- cpen = .true.
- else if (msg(imsg) .eq. 'K') then
- C PLOT
- if (cpen) then
- if (tpen) then
- call plot (nx,ny)
- else
- call plot (lx,ly)
- call plot (nx,ny)
- tpen = .true.
- end if
- else
- if (tpen) then
- iout = iout + 1
- out(iout) = int1(29)
- call plot (nx,ny)
- else
- call plot (nx,ny)
- tpen = .true.
- end if
- end if
- C
- end if
- imsg = 0
- nstate = 0
- end if
- C
- ii = ii + 1
- if (ii .gt. 1024) then
- if (eof) goto 2000
- if (.not. eof) goto 100
- end if
- C
- if (iout .gt. 128) then
- write (2) (out(i),i=1,128)
- do 900 i = 129, iout
- out(i-128) = out(i)
- 900 continue
- iout = iout - 128
- end if
- C
- goto 200
- C
- C END OF FILE READ
- 1000 eof = .true.
- goto 200
- C
- 2000 if (iout .ge. 0) write (2) (out(i),i=1,iout),
- + char(27),'[','!','p'
- C TEKTRONIX MODE IS NOW OFF AND BUFFER PURGED.
- goto 9999
- C
- 9998 write (*,*) 'useage: CAL2TEK file [/b] (no extension)'
- write (*,*) 'transforms: file.PLT ==> file.TEK'
- write (*,*) 'file.TEK must not exist'
- write (*,*) '/b option uses BOLD (thicker lines)'
- 9999 close (1)
- close (2)
- end
-
-
-
- subroutine plot (nx,ny)
- integer*1 out(200)
- integer i(5), nx, ny, lx, ly, n1, n2
- common out, iout, lx, ly
- logical xmin,xmax,ymin,ymax
- data xmin/.false./,xmax/.false./,ymin/.false./,ymax/.false./
- C
- if (nx .lt. 0) then
- if (.not. xmin) write (*,*) 'warning, truncating x < 0'
- xmin = .true.
- nx = 0
- else if (nx .gt. 2752) then
- if (.not. xmax) write (*,*) 'warning, truncating x > 2752'
- xmax = .true.
- nx = 2752
- end if
- if (ny .lt. 0) then
- if (.not. ymin) write (*,*) 'warning, truncating y < 0'
- ymin = .true.
- ny = 0
- else if (ny .gt. 1687) then
- if (.not. ymax) write (*,*) 'warning, truncating y > 1687'
- ymax = .true.
- ny = 1687
- end if
- C
- n1 = int(float(nx)/2752.*4095.+.5)
- n2 = int(float(ny)/1687.*3071.+.5)
- C
- C HI Y BYTE: BITS 8-12 Y SHIFTED RIGHT, FLAG BIT 6
- iout = iout + 1
- out(iout) = int1(n2/128 + 32)
- C EXTRA BYTE: BITS 1-2 Y SHIFTED LEFT, BITS 1-2 X, FLAG BITS 6&7
- c ***NOTE: for non LN03 TEKTRONIX graphics devices which do not
- c support the "higher resolution" mode, the next two lines
- c of source must be commented out.
- iout = iout + 1
- out(iout) = int1((n2 - 4*(n2/4))*4 + (n1 - 4*(n1/4)) + 96)
- C LO Y BYTE: BITS 3-7 Y SHIFTED RIGHT, FLAG BITS 6&7
- iout = iout + 1
- out(iout) = int1((n2 - 128*(n2/128))/4 + 96)
- if (out(iout) .eq. 127) then
- out(iout) = int1(27)
- iout = iout + 1
- out(iout) = int1(63)
- end if
- C HI X BYTE: BITS 8-12 X SHIFTED RIGHT, FLAG BIT 6
- iout = iout + 1
- out(iout) = int1(n1/128 + 32)
- C LO X BYTE: BITS 3-7 X SHIFTED RIGHT, FLAG BIT 7
- iout = iout + 1
- out(iout) = int1((n1 - 128*(n1/128))/4 + 64)
- C
- return
- end
-
- ----------------------- GETPAR.ASM -------------------
-
- ;
- ; This software is distributed as support for version 1
- ; of CAL2TEK. It is copyrighted by the author.
- ; Conditions of the copyright are listed in the accompanying
- ; file CAL2TEK.DOC. This software may not be distributed
- ; without the accompanying documentation, and this notice
- ; may not be removed.
- ;
- ; There is no warranty of any kind, and the copyright owner is not
- ; liable for damages of any kind. By using the software, you
- ; agree to this.
- ;
- ; The software and documentation are:
- ;
- ; Copyright (c) 1988 by
- ; Jeffrey A. Casey
- ; 782 Massachusetts Ave.
- ; Lexington, MA 02173
- ; (617)861-1752
- ;--------------------------------------------------------------------
- ;
- ;
- ; FORTRAN subroutine GETPAR (N,M,LINE)
- ; returns command line parameters
- ; N (INT*2) number of characters returned
- ; M (INT*2) maxlength of LINE
- ; LINE (CHAR*M) array of characters
- ;
- ; J. Casey 5/10/87
- ;
- TITLE GETPAR - get calling parameters returned to program
- ; (assy to fortran interface)
- ;
- CODE SEGMENT 'CODE'
- ASSUME CS:CODE
- PUBLIC GETPAR
- ;
- ;
- GETPAR PROC FAR
- ;
- PUSH BP ;Save framepointer on stack
- MOV BP,SP
- push ds
- push dx
- push cx
- push bx
- push ax
- ;
- ;
- mov ah,62h
- int 21h ;get psp address, ret in BX
- mov ds,bx ;set DS to psp address
- mov bx,80h ;set offset to 80H (DOS param line)
- mov al,[bx] ; then steal the count
- mov ah,0 ; and make it INT*2 size
- ;
- inc bx ;increment to start of string,
- mov si,bx ; save location of param string
- ;
- LES BX,DWORD PTR [BP+14] ;ES,BX = addr of 1st param
- mov es:[bx],ax ; return #chars
- ;
- LES BX,DWORD PTR [BP+10] ;ES,BX = addr of 2nd param
- mov cx,es:[bx] ; cx = max length returned
- ;
- LES BX,DWORD PTR [BP+6] ;ES,BX = addr of 3rd param (line)
- ;
- loop: cmp ax,0
- jle home
- cmp cx,0
- jle home
- push bx
- mov bx,si
- mov dx,[bx] ;dx now has next character of
- pop bx ; param string
- mov es:[bx],dx ;put it in LINE text string
- inc bx
- inc si
- dec ax
- dec cx
- jmp loop
- ;
- home: pop ax
- pop bx
- pop cx
- pop dx
- pop ds
- MOV SP,BP ;Restore framepointer
- POP BP
- RET 0CH ;return, pop 12 bytes
- ;
- GETPAR ENDP
- CODE ENDS
- END
-