home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Troubleshooting Netware Systems
/
CSTRIAL0196.BIN
/
attach
/
pcc
/
v08n03
/
postut.exe
/
ASCII-PS.ZIP
/
ASCII-PS.BAS
next >
Wrap
BASIC Source File
|
1990-03-25
|
14KB
|
437 lines
' This program was originally intended to run on a computer connected
' directly to a postscript printer (a QMS PS-800). The connection assumed is
' through a serial port. QuickBasic was chosen as the language because
' it was the only one available to me that supplied a full serial interface.
' As it is written, this program expects a full RS232 connection between
' printer and computer. It can be modified for other connections.
' A conversion option has been added to convert from text to postscript
' off-line by writing to a file. This could later be sent directly to the
' printer.
' This has been tested on an XT-clone connected to a QMS PS-800.
' Comments, improvements etc can be sent to David Jeffrey
' Dept Applied Mathematics
' The University of Western Ontario
' London, Ontario, Canada N6A 5B9
' DJEFFREY@UWO.CA
DECLARE SUB GetOption (Xsize%, Ysize%, StartRow%, LastRow%, ColNumber%, LandSelect%)
DECLARE SUB OpenPrinter (Success%)
DECLARE SUB LaserPrn (FileName$)
DECLARE SUB FileConv (FileName$)
DECLARE SUB SendQMS (FileName$)
DECLARE SUB ResetQMS ()
DECLARE SUB GetFileName (FileName$)
DECLARE SUB GetPrinterOutput (PrinterOutput$)
DECLARE SUB DoctorLine (PrintLine$, SpecialChr$)
DECLARE SUB ExpandTabs (PrintLine$, NumberSpaces%)
DIM XsizeOpt%(10), YsizeOpt%(10), StartOpt%(10), LastOpt%(10)
DIM ColumnsOpt%(10), LandscapeOpt%(10)
'
' QuickBasic demands that all READs and DATA be in main program
'
FOR i% = 1 TO 6
READ XsizeOpt%(i%), YsizeOpt%(i%), StartOpt%(i%), LastOpt%(i%)
READ ColumnsOpt%(i%), LandscapeOpt%(i%)
NEXT i%
DATA 12, 12, 745, 35, 1, 0
DATA 8, 11, 766, 5, 1, 0
DATA 7, 7, 730, 34, 1, 0
DATA 12, 12, 560, 30, 1, 1
DATA 7, 7, 555, 34, 1, 1
DATA 7, 7, 555, 34, 2, 1
CLS
C% = 0
WHILE C% <> 5
C% = 0
WHILE C% < 1 OR C% > 5
CLS
PRINT "Postscript printing and operation utility - version 1.0"
PRINT "Written by D. Jeffrey, UWO, London, Ontario, Canada"
PRINT : PRINT "Enter your choice of operation by the listed number"
PRINT
PRINT "1 - Convert an ascii file to a Postscript file"
PRINT "2 - Print an ascii file on an attached Postscript printer"
PRINT "3 - Send a Postscript file to an attached Postscript printer"
PRINT "4 - Reset printer (Try to end current job)"
PRINT "5 - Terminate the program"
PRINT : INPUT "Choice"; C%
IF C% < 1 OR C% > 5 THEN
PRINT "Enter a single digit number between 1 and 5"
END IF
WEND
CLS
PRINT STRING$(74, 205): PRINT
IF C% = 1 THEN
PRINT STRING$(21, 205); " CONVERT ASCII FILE TO POSTSCRIPT "; STRING$(22, 205)
CALL GetFileName(FileName$)
IF FileName$ <> "" THEN CALL FileConv(FileName$)
ELSEIF C% = 2 THEN
PRINT STRING$(21, 205); " PRINT TEXT USING LASERPRINTER "; STRING$(22, 205)
CALL GetFileName(FileName$)
IF FileName$ <> "" THEN CALL LaserPrn(FileName$)
ELSEIF C% = 3 THEN
PRINT STRING$(17, 205); " SEND A POSTSCRIPT FILE TO LASERPRINTER"; STRING$(17, 205)
CALL GetFileName(FileName$)
IF FileName$ <> "" THEN CALL SendQMS(FileName$)
ELSEIF C% = 4 THEN
PRINT STRING$(25, 205); " RESETTING LASERPRINTER "; STRING$(25, 205)
CALL ResetQMS
END IF
VIEW PRINT 1 TO 25
WEND
CLS
END
'
' QuickBasic demands that all error trapping be in main program
'
GetErrorNumber:
LastError% = ERR
SELECT CASE LastError%
CASE 24:
PRINT "Device Timeout"
CASE 52, 64:
PRINT "Bad file name"
CASE 71:
PRINT "Drive not ready"
CASE 53, 76:
PRINT "File not found"
CASE ELSE:
PRINT "Error number "; LastError%; " reported"
END SELECT
RESUME NEXT
SUB DoctorLine (L$, SpecialChr$)
tmp% = INSTR(L$, SpecialChr$)
WHILE tmp% <> 0
L$ = LEFT$(L$, tmp% - 1) + "\" + MID$(L$, tmp%)
tmp% = INSTR(tmp% + 2, L$, SpecialChr$)
WEND
END SUB
SUB ExpandTabs (L$, Spaces%)
StartLoop:
tmp% = INSTR(L$, CHR$(9))
IF tmp% <> 0 THEN
L$ = LEFT$(L$, tmp% - 1) + SPACE$(Spaces%) + MID$(L$, tmp% + 1)
GOTO StartLoop
END IF
END SUB
SUB FileConv (FileName$) STATIC
SHARED LastError%
OPEN FileName$ FOR INPUT AS #1
INPUT "Output file name "; outfile$
IF LEN(outfile$) = 0 THEN EXIT SUB
OPEN outfile$ FOR OUTPUT AS #2
PRINT " Even though the output is only to a file, the size of print must"
PRINT " be specified now so that the proper page-breaks can be calculated."
CALL GetOption(Xsize%, Ysize%, StartRow%, LastRow%, ColNumber%, LandSelect%)
PRINT STRING$(20, 205); " FILE BEING WRITTEN "; STRING$(20, 205)
L$ = ""
PRINT #2, "/Courier findfont ["; Xsize%; "0 0"; Ysize%; "0 0] makefont setfont "
PRINT #2, "/showline { gsave show grestore 0 "; -Ysize%; " rmoveto } def "
startpage1:
IF EOF(1) AND LEN(L$) = 0 THEN GOTO PageEmpty1
IF LandSelect% = 1 THEN PRINT #2, "0 770 translate -90 rotate"
Lmargin% = 18
StartCol1:
row% = StartRow%
PRINT #2, Lmargin%; " "; StartRow%; " moveto "
printloop1:
IF EOF(1) AND LEN(L$) = 0 THEN GOTO EndPrint1
IF LEN(L$) = 0 THEN
LINE INPUT #1, L$
CALL DoctorLine(L$, "\")
CALL DoctorLine(L$, "(")
CALL DoctorLine(L$, ")")
CALL ExpandTabs(L$, 8)
END IF
SendLine1:
NewPageChar% = INSTR(L$, CHR$(12))
IF NewPageChar% <> 0 THEN
Lsend$ = LEFT$(L$, NewPageChar% - 1)
L$ = MID$(L$, NewPageChar% + 1)
row% = LastRow%
ELSE
Lsend$ = L$
L$ = ""
END IF
IF LEN(Lsend$) <> 0 THEN PRINT #2, "("; Lsend$; ") showline "
row% = row% - Ysize%
IF row% > LastRow% THEN GOTO printloop1
IF (ColNumber% = 2) AND (Lmargin% = 18) THEN
Lmargin% = 380
GOTO StartCol1
END IF
PRINT #2, " showpage"
GOTO startpage1
EndPrint1:
PRINT #2, " showpage "; CHR$(4)
PageEmpty1:
CLOSE #1, #2
END SUB
SUB GetFileName (FileName$)
SHARED LastError%
ON ERROR GOTO GetErrorNumber
LINE INPUT "filename: "; Ftemp$
TryFile:
num1% = FREEFILE
OPEN Ftemp$ FOR INPUT AS num1%
IF LastError% <> 0 THEN
LINE INPUT "Enter a mask to see file list: "; Spec$
IF Spec$ <> "" THEN FILES Spec$
LastError% = 0
num1% = 0
END IF
IF num1% <> 0 THEN
CLOSE num1%
ELSE
LINE INPUT "Another filename: "; Ftemp$
IF Ftemp$ <> "" THEN GOTO TryFile
END IF
FileName$ = Ftemp$
ON ERROR GOTO 0
END SUB
SUB GetOption (Xsize%, Ysize%, StartRow%, LastRow%, ColNumber%, LandSelect%)
SHARED XsizeOpt%(), YsizeOpt%(), StartOpt%(), LastOpt%()
SHARED ColumnsOpt%(), LandscapeOpt%()
StartGet:
PRINT : PRINT " STYLE OF PRINTING ": PRINT
PRINT "Type 1 for 12 point portrait ( 60 lines by 80 cols)"
PRINT "Type 2 for 11 point portrait ( 70 lines by 120 cols)"
PRINT "Type 3 for 7 point portrait (100 lines by 137 cols)"
PRINT "Type 4 for 12 point landscape( 45 lines by 103 cols)"
PRINT "Type 5 for 7 point landscape( 75 lines by 177 cols)"
PRINT "Type 6 for 7 point landscape ( 2 columns of 80) "
PRINT "Type 7 for custom selection "
INPUT " Select printing option :", SelectOption%
IF SelectOption% < 1 OR SelectOption% > 7 THEN
PRINT " Please type a number between 1 and 7 and then ENTER"
GOTO StartGet
END IF
IF SelectOption% < 7 THEN
Xsize% = XsizeOpt%(SelectOption%)
Ysize% = YsizeOpt%(SelectOption%)
StartRow% = StartOpt%(SelectOption%)
LastRow% = LastOpt%(SelectOption%)
ColNumber% = ColumnsOpt%(SelectOption%)
LandSelect% = LandscapeOpt%(SelectOption%)
ELSE
'
' A lot of room for improvement here
'
INPUT "Xsize in points: ", Xsize%
INPUT "Ysize in points: ", Ysize%
INPUT "Starting row Y co-ordinate: ", StartRow%
INPUT "Last row Y co-ordinate: ", LastRow%
INPUT "Number of columns (1 or 2): ", ColNumber%
INPUT "Portrait = 0, Landscape= 1 ; Your choice: ", LandSelect%
END IF
END SUB
SUB GetPrinterOutput (PrinterOutput$) STATIC
' Spontaneous or generated messages from a QMS printer are always of
' the form %%[ ...message...]%%
' So as well as checking the serial port for input, it checks to make sure
' that each %%[ is matched by a ]%%
GetOutput:
IF EOF(2) THEN
RawOutput$ = ""
ELSE
RawOutput$ = INPUT$(LOC(2), #2)
END IF
' QB appears to initialize Pending$ to "" which is just as well!
Pending$ = Pending$ + RawOutput$
StartMess% = INSTR(Pending$, "%%[")
IF StartMess% <> 0 THEN
EndMess% = INSTR(Pending$, "]%%")
IF EndMess% = 0 THEN GOTO GetOutput
END IF
IF StartMess% <> 0 THEN
EndMess% = EndMess% + 4
PrinterOutput$ = LEFT$(Pending$, EndMess% - 2) 'Omit <CR>,<LF>
Pending$ = RIGHT$(Pending$, LEN(Pending$) - EndMess%)
StartMess% = 0: EndMess% = 0
ELSE
PrinterOutput$ = Pending$
Pending$ = ""
END IF
IF PrinterOutput$ <> "" THEN
VIEW PRINT 13 TO 24
LOCATE 24, 1
PRINT PrinterOutput$
END IF
IF Pending$ <> "" GOTO GetOutput
END SUB
SUB LaserPrn (FileName$) STATIC
SHARED LastError%
SHARED XsizeOpt%(), YsizeOpt%(), StartOpt%(), LastOpt%()
SHARED ColumnsOpt%(), LandscapeOpt%()
OPEN FileName$ FOR INPUT AS #1
CALL OpenPrinter(Success%)
IF Success% = 0 THEN
CLOSE #1
EXIT SUB
END IF
PRINT #2, CHR$(4); CHR$(4); CHR$(4);
PRINT #2, "serverdict begin 0 exitserver statusdict begin 25 9600 7 setsccbatch end"
PRINT #2, CHR$(4)
CALL GetOption(Xsize%, Ysize%, StartRow%, LastRow%, ColNumber%, LandSelect%)
SLEEP 2
CLS : PRINT STRING$(20, 205); " BEING SENT TO PRINTER "; STRING$(20, 205)
LOCATE 12, 1: PRINT STRING$(30, 205); " MESSAGES FROM PRINTER "
SLEEP 3
PRINT #2, CHR$(20);
' The varaible L$ holds the input data to be printed
L$ = ""
PRINT #2, "/Courier findfont ["; Xsize%; "0 0"; Ysize%; "0 0] makefont setfont "
PRINT #2, "/showline { gsave show grestore 0 "; -Ysize%; " rmoveto } def "
startpage:
'
' If we have reached the end-of-file and there is no unfinished business ...
'
IF EOF(1) AND LEN(L$) = 0 THEN GOTO PageEmpty
IF LandSelect% = 1 THEN PRINT #2, "0 770 translate -90 rotate"
Lmargin% = 18
StartCol:
row% = StartRow%
PRINT #2, Lmargin%; " "; StartRow%; " moveto "
printloop:
IF EOF(1) AND LEN(L$) = 0 THEN GOTO EndPrint
IF LEN(L$) = 0 THEN
LINE INPUT #1, L$
CALL DoctorLine(L$, "\")
CALL DoctorLine(L$, "(")
CALL DoctorLine(L$, ")")
CALL ExpandTabs(L$, 8)
END IF
SendLine:
NewPageChar% = INSTR(L$, CHR$(12))
IF NewPageChar% <> 0 THEN
Lsend$ = LEFT$(L$, NewPageChar% - 1)
L$ = MID$(L$, NewPageChar% + 1)
row% = LastRow%
ELSE
Lsend$ = L$
L$ = ""
END IF
PRINT #2, "("; Lsend$; ") showline "
VIEW PRINT 3 TO 11
LOCATE 11, 1
PRINT LEFT$(Lsend$, 79)
GetPrinterOutput (PrinterOutput$)
row% = row% - Ysize%
IF row% > LastRow% THEN GOTO printloop
IF (ColNumber% = 2) AND (Lmargin% = 18) THEN
Lmargin% = 380
GOTO StartCol
END IF
PRINT #2, " showpage"
VIEW PRINT 3 TO 11
LOCATE 11, 1
PRINT : PRINT "************************showpage***********************"
GOTO startpage
EndPrint:
PRINT #2, " showpage "; CHR$(4)
PageEmpty:
PRINT #2, "serverdict begin 0 exitserver statusdict begin 25 9600 3 setsccbatch end"
PRINT #2, CHR$(4)
CLOSE #1, #2
SLEEP 2
END SUB
SUB OpenPrinter (Success%)
SHARED LastError%
ON ERROR GOTO GetErrorNumber
OpenPrinter:
OPEN "COM1:9600,N,8,1,CS60000,DS60000,OP5000" FOR RANDOM AS #2 LEN = 512
IF LastError% <> 0 THEN
IF LastError% = 24 THEN
LastError% = 0
PRINT "Is the printer connected to the computer?"
INPUT "Shall we try again? (y/n)"; ans$
IF UCASE$(ans$) = "N" THEN EXIT SUB
GOTO OpenPrinter
ELSE
PRINT "Unexpected error. What have you done? Press return": INPUT ans$
Success% = 0
EXIT SUB
END IF
END IF
ON ERROR GOTO 0
Success% = 1
END SUB
SUB ResetQMS STATIC
PRINT " Many programs change the state of a Postscript printer in ways"
PRINT " that cannot be undone. If the printer fails to work as expected"
PRINT " after this option is finished, you might try it a second time,"
PRINT " but after that, a power down and up is probably necessary."
CALL OpenPrinter(Success%)
IF Success% = 0 THEN EXIT SUB
'
' A QMS printer returns its current status when sent a control-T
PRINT #2, CHR$(20);
SLEEP 2
CALL GetPrinterOutput(PrinterOutput$)
' A control-D tells a QMS printer that the previous job has ended.
' This should stop any unsuccessful job that is running.
PRINT #2, CHR$(4); CHR$(20);
'
' I first thought that getting the little flashing light on the QMS
' printer to turn off and have the printer report "idle"
' would be a good thing. However, this does not retrieve memory
' consumed by down-loaded fonts anyway, so I removed the code that did this.
' This code works fine when run from the QB environment. It also works OK
' when compiled without the DEBUG code option (control/D). But the DEBUG
' option seems to confuse something.
'
SLEEP 2
CALL GetPrinterOutput(PrinterOutput$)
INPUT "Press return to continue", ans$
CLOSE #2
END SUB
SUB SendQMS (FileName$) STATIC
SHARED LastError%
OPEN FileName$ FOR BINARY AS #1
'
' I open the input file as binary because some programs write Postscript
' files that do not contain the cr/lf sequence. BASIC finds it difficult
' to treat these as sequential files.
'
CALL OpenPrinter(Success%)
IF Success% = 0 THEN
CLOSE #1
EXIT SUB
END IF
PRINT #2, CHR$(4); CHR$(4);
PRINT #2, "serverdict begin 0 exitserver statusdict begin 25 9600 7 setsccbatch end";
PRINT #2, CHR$(4);
SLEEP 2
CLS : PRINT STRING$(20, 205); " BEING SENT TO PRINTER "; STRING$(20, 205)
LOCATE 12, 1: PRINT STRING$(30, 205); " MESSAGES FROM PRINTER "
SLEEP 3
PRINT #2, CHR$(20);
printlp:
L$ = INPUT$(60, #1)
IF LEN(L$) <> 0 THEN
PRINT #2, L$;
VIEW PRINT 3 TO 11
LOCATE 11, 1
PRINT L$
CALL GetPrinterOutput(PrinterOutput$)
GOTO printlp
END IF
PRINT #2, "serverdict begin 0 exitserver statusdict begin 25 9600 3 setsccbatch end"
PRINT #2, CHR$(4)
CLOSE #1, #2
END SUB