home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1992 December
/
simtel1292_SIMTEL_1292_Walnut_Creek.iso
/
msdos
/
printer
/
cal2tek.lib
< prev
next >
Wrap
Internet Message Format
|
1988-02-28
|
20KB
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