home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / PRINTING / ASCII_PS.ZIP / ASCII-PS.BAS next >
BASIC Source File  |  1990-03-25  |  14KB  |  437 lines
  1. ' This program was originally intended to run on a computer connected
  2. ' directly to a postscript printer (a QMS PS-800). The connection assumed is
  3. ' through a serial port. QuickBasic was chosen as the language because
  4. ' it was the only one available to me that supplied a full serial interface.
  5. ' As it is written, this program expects a full RS232 connection between
  6. ' printer and computer. It can be modified for other connections.
  7. ' A conversion option has been added to convert from text to postscript
  8. ' off-line by writing to a file. This could later be sent directly to the
  9. ' printer.
  10. ' This has been tested on an XT-clone connected to a QMS PS-800.
  11. ' Comments, improvements etc can be sent to David Jeffrey
  12. '                                           Dept Applied Mathematics
  13. '                                           The University of Western Ontario
  14. '                                           London, Ontario, Canada N6A 5B9
  15. '                                           DJEFFREY@UWO.CA
  16. DECLARE SUB GetOption (Xsize%, Ysize%, StartRow%, LastRow%, ColNumber%, LandSelect%)
  17. DECLARE SUB OpenPrinter (Success%)
  18. DECLARE SUB LaserPrn (FileName$)
  19. DECLARE SUB FileConv (FileName$)
  20. DECLARE SUB SendQMS (FileName$)
  21. DECLARE SUB ResetQMS ()
  22. DECLARE SUB GetFileName (FileName$)
  23. DECLARE SUB GetPrinterOutput (PrinterOutput$)
  24. DECLARE SUB DoctorLine (PrintLine$, SpecialChr$)
  25. DECLARE SUB ExpandTabs (PrintLine$, NumberSpaces%)
  26. DIM XsizeOpt%(10), YsizeOpt%(10), StartOpt%(10), LastOpt%(10)
  27. DIM ColumnsOpt%(10), LandscapeOpt%(10)
  28. '
  29. ' QuickBasic demands that all READs and DATA be in main program
  30. '
  31. FOR i% = 1 TO 6
  32.  READ XsizeOpt%(i%), YsizeOpt%(i%), StartOpt%(i%), LastOpt%(i%)
  33.  READ ColumnsOpt%(i%), LandscapeOpt%(i%)
  34. NEXT i%
  35. DATA 12, 12, 745, 35, 1, 0
  36. DATA  8, 11, 766,  5, 1, 0
  37. DATA  7,  7, 730, 34, 1, 0
  38. DATA 12, 12, 560, 30, 1, 1
  39. DATA  7,  7, 555, 34, 1, 1
  40. DATA  7,  7, 555, 34, 2, 1
  41. CLS
  42.  
  43. C% = 0
  44. WHILE C% <> 5
  45.    C% = 0
  46.    WHILE C% < 1 OR C% > 5
  47.       CLS
  48.       PRINT "Postscript printing and operation utility - version 1.0"
  49.       PRINT "Written by D. Jeffrey, UWO, London, Ontario, Canada"
  50.       PRINT : PRINT "Enter your choice of operation by the listed number"
  51.       PRINT
  52.       PRINT "1 - Convert an ascii file to a Postscript file"
  53.       PRINT "2 - Print an ascii file on an attached Postscript printer"
  54.       PRINT "3 - Send a Postscript file to an attached Postscript printer"
  55.       PRINT "4 - Reset printer (Try to end current job)"
  56.       PRINT "5 - Terminate the program"
  57.       PRINT : INPUT "Choice"; C%
  58.       IF C% < 1 OR C% > 5 THEN
  59.          PRINT "Enter a single digit number between 1 and 5"
  60.       END IF
  61.    WEND
  62.    CLS
  63.    PRINT STRING$(74, 205): PRINT
  64.    IF C% = 1 THEN
  65.       PRINT STRING$(21, 205); " CONVERT ASCII FILE TO POSTSCRIPT "; STRING$(22, 205)
  66.       CALL GetFileName(FileName$)
  67.       IF FileName$ <> "" THEN CALL FileConv(FileName$)
  68.    ELSEIF C% = 2 THEN
  69.       PRINT STRING$(21, 205); " PRINT TEXT USING LASERPRINTER "; STRING$(22, 205)
  70.       CALL GetFileName(FileName$)
  71.       IF FileName$ <> "" THEN CALL LaserPrn(FileName$)
  72.    ELSEIF C% = 3 THEN
  73.       PRINT STRING$(17, 205); " SEND A POSTSCRIPT FILE TO LASERPRINTER"; STRING$(17, 205)
  74.       CALL GetFileName(FileName$)
  75.       IF FileName$ <> "" THEN CALL SendQMS(FileName$)
  76.    ELSEIF C% = 4 THEN
  77.       PRINT STRING$(25, 205); " RESETTING LASERPRINTER "; STRING$(25, 205)
  78.       CALL ResetQMS
  79.    END IF
  80.    VIEW PRINT 1 TO 25
  81. WEND
  82. CLS
  83. END
  84. '
  85. ' QuickBasic demands that all error trapping be in main program
  86. '
  87. GetErrorNumber:
  88.   LastError% = ERR
  89.     SELECT CASE LastError%
  90.      CASE 24:
  91.        PRINT "Device Timeout"
  92.      CASE 52, 64:
  93.        PRINT "Bad file name"
  94.      CASE 71:
  95.        PRINT "Drive not ready"
  96.      CASE 53, 76:
  97.        PRINT "File not found"
  98.      CASE ELSE:
  99.        PRINT "Error number "; LastError%; " reported"
  100.     END SELECT
  101.   RESUME NEXT
  102.  
  103. SUB DoctorLine (L$, SpecialChr$)
  104.   tmp% = INSTR(L$, SpecialChr$)
  105.   WHILE tmp% <> 0
  106.    L$ = LEFT$(L$, tmp% - 1) + "\" + MID$(L$, tmp%)
  107.    tmp% = INSTR(tmp% + 2, L$, SpecialChr$)
  108.   WEND
  109.  
  110. END SUB
  111.  
  112. SUB ExpandTabs (L$, Spaces%)
  113. StartLoop:
  114.   tmp% = INSTR(L$, CHR$(9))
  115.   IF tmp% <> 0 THEN
  116.     L$ = LEFT$(L$, tmp% - 1) + SPACE$(Spaces%) + MID$(L$, tmp% + 1)
  117.     GOTO StartLoop
  118.   END IF
  119. END SUB
  120.  
  121. SUB FileConv (FileName$) STATIC
  122. SHARED LastError%
  123.   OPEN FileName$ FOR INPUT AS #1
  124.   INPUT "Output file name "; outfile$
  125.   IF LEN(outfile$) = 0 THEN EXIT SUB
  126.   OPEN outfile$ FOR OUTPUT AS #2
  127.   PRINT " Even though the output is only to a file, the size of print must"
  128.   PRINT " be specified now so that the proper page-breaks can be calculated."
  129.   CALL GetOption(Xsize%, Ysize%, StartRow%, LastRow%, ColNumber%, LandSelect%)
  130.   PRINT STRING$(20, 205); " FILE BEING WRITTEN "; STRING$(20, 205)
  131.   L$ = ""
  132.   PRINT #2, "/Courier findfont ["; Xsize%; "0 0"; Ysize%; "0 0] makefont setfont "
  133.   PRINT #2, "/showline { gsave show grestore 0 "; -Ysize%; " rmoveto } def "
  134. startpage1:
  135.   IF EOF(1) AND LEN(L$) = 0 THEN GOTO PageEmpty1
  136.   IF LandSelect% = 1 THEN PRINT #2, "0 770 translate -90 rotate"
  137.   Lmargin% = 18
  138. StartCol1:
  139.   row% = StartRow%
  140.   PRINT #2, Lmargin%; " "; StartRow%; " moveto "
  141. printloop1:
  142.   IF EOF(1) AND LEN(L$) = 0 THEN GOTO EndPrint1
  143.   IF LEN(L$) = 0 THEN
  144.     LINE INPUT #1, L$
  145.     CALL DoctorLine(L$, "\")
  146.     CALL DoctorLine(L$, "(")
  147.     CALL DoctorLine(L$, ")")
  148.     CALL ExpandTabs(L$, 8)
  149.   END IF
  150. SendLine1:
  151.   NewPageChar% = INSTR(L$, CHR$(12))
  152.   IF NewPageChar% <> 0 THEN
  153.     Lsend$ = LEFT$(L$, NewPageChar% - 1)
  154.     L$ = MID$(L$, NewPageChar% + 1)
  155.     row% = LastRow%
  156.   ELSE
  157.     Lsend$ = L$
  158.     L$ = ""
  159.   END IF
  160.   IF LEN(Lsend$) <> 0 THEN PRINT #2, "("; Lsend$; ") showline "
  161.   row% = row% - Ysize%
  162.   IF row% > LastRow% THEN GOTO printloop1
  163.   IF (ColNumber% = 2) AND (Lmargin% = 18) THEN
  164.     Lmargin% = 380
  165.     GOTO StartCol1
  166.   END IF
  167.   PRINT #2, " showpage"
  168.   GOTO startpage1
  169. EndPrint1:
  170.   PRINT #2, " showpage "; CHR$(4)
  171. PageEmpty1:
  172.   CLOSE #1, #2
  173. END SUB
  174.  
  175. SUB GetFileName (FileName$)
  176. SHARED LastError%
  177.    ON ERROR GOTO GetErrorNumber
  178.    LINE INPUT "filename: "; Ftemp$
  179. TryFile:
  180.    num1% = FREEFILE
  181.    OPEN Ftemp$ FOR INPUT AS num1%
  182.    IF LastError% <> 0 THEN
  183.      LINE INPUT "Enter a mask to see file list: "; Spec$
  184.      IF Spec$ <> "" THEN FILES Spec$
  185.      LastError% = 0
  186.      num1% = 0
  187.    END IF
  188.    IF num1% <> 0 THEN
  189.      CLOSE num1%
  190.    ELSE
  191.      LINE INPUT "Another filename: "; Ftemp$
  192.      IF Ftemp$ <> "" THEN GOTO TryFile
  193.    END IF
  194.    FileName$ = Ftemp$
  195.    ON ERROR GOTO 0
  196. END SUB
  197.  
  198. SUB GetOption (Xsize%, Ysize%, StartRow%, LastRow%, ColNumber%, LandSelect%)
  199. SHARED XsizeOpt%(), YsizeOpt%(), StartOpt%(), LastOpt%()
  200. SHARED ColumnsOpt%(), LandscapeOpt%()
  201. StartGet:
  202.   PRINT : PRINT " STYLE OF PRINTING ": PRINT
  203.   PRINT "Type 1 for 12 point portrait ( 60 lines by  80 cols)"
  204.   PRINT "Type 2 for 11 point portrait ( 70 lines by 120 cols)"
  205.   PRINT "Type 3 for  7 point portrait (100 lines by 137 cols)"
  206.   PRINT "Type 4 for 12 point landscape( 45 lines by 103 cols)"
  207.   PRINT "Type 5 for  7 point landscape( 75 lines by 177 cols)"
  208.   PRINT "Type 6 for  7 point landscape ( 2 columns of 80)    "
  209.   PRINT "Type 7 for custom selection                         "
  210.   INPUT " Select printing option :", SelectOption%
  211.   IF SelectOption% < 1 OR SelectOption% > 7 THEN
  212.      PRINT " Please type a number between 1 and 7 and then ENTER"
  213.      GOTO StartGet
  214.   END IF
  215. IF SelectOption% < 7 THEN
  216.    Xsize% = XsizeOpt%(SelectOption%)
  217.    Ysize% = YsizeOpt%(SelectOption%)
  218.    StartRow% = StartOpt%(SelectOption%)
  219.    LastRow% = LastOpt%(SelectOption%)
  220.    ColNumber% = ColumnsOpt%(SelectOption%)
  221.    LandSelect% = LandscapeOpt%(SelectOption%)
  222. ELSE
  223. '
  224. ' A lot of room for improvement here
  225. '
  226.    INPUT "Xsize in points: ", Xsize%
  227.    INPUT "Ysize in points: ", Ysize%
  228.    INPUT "Starting row Y co-ordinate: ", StartRow%
  229.    INPUT "Last row Y co-ordinate: ", LastRow%
  230.    INPUT "Number of columns (1 or 2): ", ColNumber%
  231.    INPUT "Portrait = 0, Landscape= 1 ; Your choice: ", LandSelect%
  232. END IF
  233. END SUB
  234.  
  235. SUB GetPrinterOutput (PrinterOutput$) STATIC
  236. ' Spontaneous or generated messages from a QMS printer are always of
  237. ' the form %%[ ...message...]%%
  238. ' So as well as checking the serial port for input, it checks to make sure
  239. ' that each %%[ is matched by a ]%%
  240. GetOutput:
  241.   IF EOF(2) THEN
  242.     RawOutput$ = ""
  243.   ELSE
  244.     RawOutput$ = INPUT$(LOC(2), #2)
  245.   END IF
  246. ' QB appears to initialize Pending$ to "" which is just as well!
  247.   Pending$ = Pending$ + RawOutput$
  248.   StartMess% = INSTR(Pending$, "%%[")
  249.   IF StartMess% <> 0 THEN
  250.     EndMess% = INSTR(Pending$, "]%%")
  251.     IF EndMess% = 0 THEN GOTO GetOutput
  252.   END IF
  253.   IF StartMess% <> 0 THEN
  254.     EndMess% = EndMess% + 4
  255.     PrinterOutput$ = LEFT$(Pending$, EndMess% - 2)   'Omit <CR>,<LF>
  256.     Pending$ = RIGHT$(Pending$, LEN(Pending$) - EndMess%)
  257.     StartMess% = 0: EndMess% = 0
  258.   ELSE
  259.     PrinterOutput$ = Pending$
  260.     Pending$ = ""
  261.   END IF
  262.   IF PrinterOutput$ <> "" THEN
  263.     VIEW PRINT 13 TO 24
  264.     LOCATE 24, 1
  265.     PRINT PrinterOutput$
  266.   END IF
  267.   IF Pending$ <> "" GOTO GetOutput
  268. END SUB
  269.  
  270. SUB LaserPrn (FileName$) STATIC
  271. SHARED LastError%
  272. SHARED XsizeOpt%(), YsizeOpt%(), StartOpt%(), LastOpt%()
  273. SHARED ColumnsOpt%(), LandscapeOpt%()
  274.  
  275.   OPEN FileName$ FOR INPUT AS #1
  276.   CALL OpenPrinter(Success%)
  277.   IF Success% = 0 THEN
  278.     CLOSE #1
  279.     EXIT SUB
  280.   END IF
  281.   PRINT #2, CHR$(4); CHR$(4); CHR$(4);
  282.   PRINT #2, "serverdict begin 0 exitserver statusdict begin 25 9600 7 setsccbatch end"
  283.   PRINT #2, CHR$(4)
  284.   CALL GetOption(Xsize%, Ysize%, StartRow%, LastRow%, ColNumber%, LandSelect%)
  285.  
  286.   SLEEP 2
  287.   CLS : PRINT STRING$(20, 205); " BEING SENT TO PRINTER "; STRING$(20, 205)
  288.   LOCATE 12, 1: PRINT STRING$(30, 205); " MESSAGES FROM PRINTER "
  289.   SLEEP 3
  290.   PRINT #2, CHR$(20);
  291. ' The varaible L$ holds the input data to be printed
  292.   L$ = ""
  293.   PRINT #2, "/Courier findfont ["; Xsize%; "0 0"; Ysize%; "0 0] makefont setfont "
  294.   PRINT #2, "/showline { gsave show grestore 0 "; -Ysize%; " rmoveto } def "
  295. startpage:
  296. '
  297. ' If we have reached the end-of-file and there is no unfinished business ...
  298. '
  299.   IF EOF(1) AND LEN(L$) = 0 THEN GOTO PageEmpty
  300.   IF LandSelect% = 1 THEN PRINT #2, "0 770 translate -90 rotate"
  301.   Lmargin% = 18
  302. StartCol:
  303.   row% = StartRow%
  304.   PRINT #2, Lmargin%; " "; StartRow%; " moveto "
  305. printloop:
  306.   IF EOF(1) AND LEN(L$) = 0 THEN GOTO EndPrint
  307.   IF LEN(L$) = 0 THEN
  308.     LINE INPUT #1, L$
  309.     CALL DoctorLine(L$, "\")
  310.     CALL DoctorLine(L$, "(")
  311.     CALL DoctorLine(L$, ")")
  312.     CALL ExpandTabs(L$, 8)
  313.   END IF
  314. SendLine:
  315.   NewPageChar% = INSTR(L$, CHR$(12))
  316.   IF NewPageChar% <> 0 THEN
  317.     Lsend$ = LEFT$(L$, NewPageChar% - 1)
  318.     L$ = MID$(L$, NewPageChar% + 1)
  319.     row% = LastRow%
  320.   ELSE
  321.     Lsend$ = L$
  322.     L$ = ""
  323.   END IF
  324.   PRINT #2, "("; Lsend$; ") showline "
  325.   VIEW PRINT 3 TO 11
  326.   LOCATE 11, 1
  327.   PRINT LEFT$(Lsend$, 79)
  328.   GetPrinterOutput (PrinterOutput$)
  329.   row% = row% - Ysize%
  330.   IF row% > LastRow% THEN GOTO printloop
  331.   IF (ColNumber% = 2) AND (Lmargin% = 18) THEN
  332.     Lmargin% = 380
  333.     GOTO StartCol
  334.   END IF
  335.   PRINT #2, " showpage"
  336.   VIEW PRINT 3 TO 11
  337.   LOCATE 11, 1
  338.   PRINT : PRINT "************************showpage***********************"
  339.   GOTO startpage
  340. EndPrint:
  341.   PRINT #2, " showpage "; CHR$(4)
  342. PageEmpty:
  343.   PRINT #2, "serverdict begin 0 exitserver statusdict begin 25 9600 3 setsccbatch end"
  344.   PRINT #2, CHR$(4)
  345.   CLOSE #1, #2
  346.   SLEEP 2
  347. END SUB
  348.  
  349. SUB OpenPrinter (Success%)
  350. SHARED LastError%
  351. ON ERROR GOTO GetErrorNumber
  352. OpenPrinter:
  353.   OPEN "COM1:9600,N,8,1,CS60000,DS60000,OP5000" FOR RANDOM AS #2 LEN = 512
  354.   IF LastError% <> 0 THEN
  355.     IF LastError% = 24 THEN
  356.       LastError% = 0
  357.       PRINT "Is the printer connected to the computer?"
  358.       INPUT "Shall we try again? (y/n)"; ans$
  359.       IF UCASE$(ans$) = "N" THEN EXIT SUB
  360.       GOTO OpenPrinter
  361.     ELSE
  362.       PRINT "Unexpected error. What have you done? Press return": INPUT ans$
  363.       Success% = 0
  364.       EXIT SUB
  365.     END IF
  366.   END IF
  367.   ON ERROR GOTO 0
  368.   Success% = 1
  369. END SUB
  370.  
  371. SUB ResetQMS STATIC
  372.   PRINT " Many programs change the state of a Postscript printer in ways"
  373.   PRINT " that cannot be undone. If the printer fails to work as expected"
  374.   PRINT " after this option is finished, you might try it a second time,"
  375.   PRINT " but after that, a power down and up is probably necessary."
  376.   CALL OpenPrinter(Success%)
  377.   IF Success% = 0 THEN EXIT SUB
  378. '
  379. ' A QMS printer returns its current status when sent a control-T
  380.   PRINT #2, CHR$(20);
  381.   SLEEP 2
  382.   CALL GetPrinterOutput(PrinterOutput$)
  383. ' A control-D tells a QMS printer that the previous job has ended.
  384. ' This should stop any unsuccessful job that is running.
  385.   PRINT #2, CHR$(4); CHR$(20);
  386. '
  387. ' I first thought that getting the little flashing light on the QMS
  388. ' printer to turn off and have the printer report "idle"
  389. ' would be a good thing. However, this does not retrieve memory
  390. ' consumed by down-loaded fonts anyway, so I removed the code that did this.
  391. ' This code works fine when run from the QB environment. It also works OK
  392. ' when compiled without the DEBUG code option (control/D). But the DEBUG
  393. ' option seems to confuse something.
  394. '
  395.   SLEEP 2
  396.   CALL GetPrinterOutput(PrinterOutput$)
  397.   INPUT "Press return to continue", ans$
  398.   CLOSE #2
  399. END SUB
  400.  
  401. SUB SendQMS (FileName$) STATIC
  402. SHARED LastError%
  403.   OPEN FileName$ FOR BINARY AS #1
  404. '
  405. ' I open the input file as binary because some programs write Postscript
  406. ' files that do not contain the cr/lf sequence. BASIC finds it difficult
  407. ' to treat these as sequential files.
  408. '
  409.   CALL OpenPrinter(Success%)
  410.   IF Success% = 0 THEN
  411.     CLOSE #1
  412.     EXIT SUB
  413.   END IF
  414.   PRINT #2, CHR$(4); CHR$(4);
  415.   PRINT #2, "serverdict begin 0 exitserver statusdict begin 25 9600 7 setsccbatch end";
  416.   PRINT #2, CHR$(4);
  417.   SLEEP 2
  418.   CLS : PRINT STRING$(20, 205); " BEING SENT TO PRINTER "; STRING$(20, 205)
  419.   LOCATE 12, 1: PRINT STRING$(30, 205); " MESSAGES FROM PRINTER "
  420.   SLEEP 3
  421.   PRINT #2, CHR$(20);
  422. printlp:
  423.   L$ = INPUT$(60, #1)
  424.   IF LEN(L$) <> 0 THEN
  425.     PRINT #2, L$;
  426.     VIEW PRINT 3 TO 11
  427.     LOCATE 11, 1
  428.     PRINT L$
  429.     CALL GetPrinterOutput(PrinterOutput$)
  430.     GOTO printlp
  431.   END IF
  432.   PRINT #2, "serverdict begin 0 exitserver statusdict begin 25 9600 3 setsccbatch end"
  433.   PRINT #2, CHR$(4)
  434.   CLOSE #1, #2
  435.  
  436. END SUB
  437.