Programmer 7500/MAX_PROGRAMMERS.iso/INFO/PSTSCRPT/ASCII_PS.ZIP/ASCII-PS.BAS

BASIC Source File | 1990-03-25 | 14.1 KB | 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
'                                           [e-mail]
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