Category : Files from Magazines
Archive   : VOL9N17.ZIP
Filename : PCBOOK.BAS

'PCBook.BAS
'Utility to print ASCII text files to LaserJet Series II, IIp or III
' in booklet format
'
'Copyright 1990 PC Magazine - Ziff Davis - Jay Munro
'Written by Jay Munro
'===========================================================================
'LaserJet programming concepts employed:
' Setting orientation & font style
' Locating LaserJet cursor
' LaserJet Macro setup and use
'===========================================================================
'General programming concepts
' Building index arrays
' Using files for printing
'
'Compiler syntax:
' BC /o /x PCBook.BAS;
' Link /ex PCBook;
'
DEFINT A-Z
DECLARE SUB BuildArray (PtrArray&(), Pgcount%)
DECLARE SUB DoMacro (Num$) 'Execute Laserjet macro
DECLARE SUB EndMacro (Num$) 'End of macro commands
DECLARE SUB Header (Page%) 'Print Header
DECLARE SUB LJLocate (X%, Y%) 'Laserjet cursor locate
DECLARE SUB PrintSetup () 'Set up macros, fonts
DECLARE SUB PrintLogo () 'Credits
DECLARE SUB StartMacro (Num$) 'Start of macro commands

TYPE Flags 'Misc flag variables
CurDate AS INTEGER
DoHeader AS INTEGER
FileTitle AS INTEGER
LineLen AS INTEGER
LineWrap AS INTEGER
PgNumber AS INTEGER
END TYPE

'Share variables with subs

DIM SHARED ESC$, FF$, LF$, FileName$
DIM SHARED PC AS Flags

REDIM PtrArray&(513) 'total number of pages (512)

ON ERROR GOTO ErrorDept 'Error trapping

'============== Set some constant variables
ESC$ = CHR$(27) 'Standard ESC code
FF$ = CHR$(12) 'Page Feed
LF$ = CHR$(10) 'Line Feed
OutFile$ = "LPT1" 'printer port
JustCount% = 0 'Pause after page count off
Tune% = 0
PC.LineLen = 80 'Maximum length of line

CLS
CALL PrintLogo

'============== Setup from the command line
IF LEN(COMMAND$) THEN 'do this only when command$ is used
IF LEFT$(LTRIM$(COMMAND$), 1) <> "/" THEN
IF INSTR(COMMAND$, "/") THEN
FileName$ = MID$(LTRIM$(COMMAND$), 1, INSTR(LTRIM$(COMMAND$), " "))
ELSE
FileName$ = LTRIM$(COMMAND$)
END IF
END IF

IF INSTR(COMMAND$, "/D") THEN
PC.CurDate = -1 'Do current date
PC.DoHeader = -1
END IF

IF INSTR(COMMAND$, "/F") THEN
PC.FileTitle = -1 'Do file title
PC.DoHeader = -1
END IF

IF INSTR(COMMAND$, "/P") THEN
PC.PgNumber = -1 'Do page numbers
PC.DoHeader = -1
END IF

IF INSTR(COMMAND$, "/C") THEN
JustCount% = -1 'Just count pages
END IF

IF INSTR(COMMAND$, "/2") THEN 'Use LPT2
OutFile$ = "Lpt2"
END IF

IF INSTR(COMMAND$, "/W") THEN 'Use linewrap
PC.LineWrap = -1
END IF

IF INSTR(COMMAND$, "/S") THEN 'Use beep statements
Tune% = -1
END IF

IF INSTR(COMMAND$, "/H") THEN 'Show help
PRINT "Usage: PCBOOK filename [/F] [/P] [/D] [/C] [/2] [/A] [/W] [/S] [/H]"
PRINT "/F - prints file name at top of page"
PRINT "/P - prints page numbers"
PRINT "/D - prints current date on every page"
PRINT "/C - pauses after physical page count"
PRINT "/2 - print to LPT2"
PRINT "/A - prompt for alternate file to print to"
PRINT "/W - set line wrap on"
PRINT "/S - sound on"
PRINT "/H - this help message"
GOTO OutHere
END IF
END IF

'============== Open text file

GetName:
IF LEN(FileName$) = 0 THEN
IF Tune% THEN BEEP
LINE INPUT "Enter file name to print: "; FileName$
PRINT
IF FileName$ = "" THEN GOTO OutHere
END IF 'Test if file is there
OPEN FileName$ FOR INPUT AS #1 ' by forcing an error
CLOSE #1 'BASIC 7 can use Dir$ instead

'============== Prompt for new output file if requested
IF INSTR(COMMAND$, "/A") THEN 'Prompt for output file
PRINT
IF Tune% THEN BEEP
LINE INPUT "Enter alternate output file: "; Temp$
IF Temp$ <> "" THEN OutFile$ = Temp$ 'allow a change of mind
PRINT
END IF

'============== Build index array for pages in FileName$
PRINT "Reading file "; FileName$
CALL BuildArray(PtrArray&(), Page%) 'Built pointer array

'============== Figure number of pages needed
IF Page% MOD 4 THEN 'Even multiples of 4 only
Page% = Page% + (4 - Page% MOD 4) ' correct for less
END IF

PRINT
PRINT "You will print "; Page% \ 4; "sheets" 'Report total number of pages
PRINT

IF JustCount% THEN
PRINT "Press any key to continue, or ESC to cancel printing"
GOSUB KeyIn
END IF

OPEN OutFile$ FOR OUTPUT AS #2 'Open printer or output file
CALL PrintSetup 'Set up printer

'Page parsing variables
LeftSide% = Page%
RightSide% = 1
FirstPass% = -1

OPEN FileName$ FOR BINARY AS #1 'Open the input file
PRINT "Printing Side 1 to "; OutFile$; 'Track what is going on

'============== Start of print routine

DoPass:
Bookmark% = (Page% \ 4) 'Flag for halfway through
IF Bookmark% = 0 THEN Bookmark% = 1 'Force 1 if too small

'============== Read text and send to printer
DO 'Print the right side of the page first
IF PtrArray&(RightSide% + 1) = 0 THEN 'If blank, then skip it
GOTO NextPage
END IF
CALL DoMacro("2") 'Start on right side
LJLocate 95, 0 'Home the cursor

IF PC.DoHeader THEN CALL Header(RightSide%) 'Header if needed
Buffer$ = SPACE$(PtrArray&(RightSide% + 1) - PtrArray&(RightSide%))

GET #1, PtrArray&(RightSide%), Buffer$ 'Read in a page

IF INSTR(Buffer$, FF$) THEN 'If the last character is a PF
PRINT #2, LEFT$(Buffer$, INSTR(Buffer$, FF$) - 1); 'print only text
ELSE
PRINT #2, Buffer$; 'Otherwise print full line
END IF

NextPage:
IF PtrArray&(LeftSide% + 1) = 0 THEN 'Don't print blank pages
GOTO NextPage1
END IF
CALL DoMacro("1") 'Reset margins for left side
LJLocate 0, 0 'Home the cursor
IF PC.DoHeader THEN CALL Header(LeftSide%) 'Header if needed
Buffer$ = SPACE$(PtrArray&(LeftSide% + 1) - PtrArray&(LeftSide%)) 'Setup buffer for input
IF LeftSide% = 0 THEN 'If pointing at blank page, skip
GOTO NextPage1
END IF
GET #1, PtrArray&(LeftSide%), Buffer$ 'Read in a page

IF INSTR(Buffer$, FF$) THEN 'if the last character is a PF
PRINT #2, LEFT$(Buffer$, INSTR(Buffer$, FF$) - 1); 'print only text
ELSE 'print only text
PRINT #2, Buffer$; 'otherwise print all
END IF

NextPage1:
PRINT #2, FF$; 'Page feed
LeftSide% = LeftSide - 2 'Calculate next page in series
RightSide% = RightSide + 2
Bookmark% = Bookmark% - 1 'Track our progress

LOOP UNTIL Bookmark% = 0 'Print pages until halfway through

'============== Pause between sides
IF FirstPass THEN 'If side one, prompt and get 2nd side
LOCATE , 1
PRINT "Insert paper back in tray and press Enter"
IF Tune% THEN BEEP

WaitKey: 'Press any key to continue loop
A$ = "" 'Set A$ = Null string - 0 length
DO
A$ = INKEY$ 'Get a key if one is pending
LOOP UNTIL LEN(A$) 'Integer compares faster than strings
IF ASC(A$) = 27 THEN GOTO PrtReset 'ESC key, takes you out
IF ASC(A$) <> 13 THEN GOTO WaitKey 'Enter key only to prevent accidentally
' starting printer
FirstPass = 0 'Flag for second pass
PRINT
PRINT "Printing Side 2 to "; OutFile$; 'Report on progress
GOTO DoPass
END IF 'End of first pass

LOCATE , 1 'Printing is done now
PRINT "Printing completed "; SPACE$(60)
IF Tune% THEN BEEP

PrtReset:
PRINT #2, ESC$; "E"; 'Reset laserjet

OutHere:
CLOSE 'Close all files
END 'Thats all for now

'============== Error handler
ErrorDept:
PRINT
PRINT "*** Error ***"
BEEP
SELECT CASE ERR
CASE 24
PRINT ERDEV$; " timed out"
CASE 25 'Device fault
PRINT "Device Fault on "; ERDEV$
CASE 27 'Paper is out
PRINT "Out of paper on "; ERDEV$
CASE 53 'Source file not there
PRINT "File "; FileName$; " not found"
FileName$ = ""
GOSUB AWayOut
RESUME GetName
CASE 71 'Open drive door
PRINT "Disk drive "; ERDEV$; " not ready"
CASE ELSE
PRINT "Error number "; ERR
IF LEN(ERDEV$) THEN PRINT ERDEV$
END SELECT
GOSUB AWayOut
RESUME

AWayOut:
PRINT
PRINT "Press any key to try again"
PRINT "Or ESC to quit"
PRINT

KeyIn: 'Wait on error for a key
A$ = ""
DO
A$ = INKEY$
LOOP UNTIL LEN(A$)
IF ASC(A$) = 27 THEN 'Exit out if ESC is pressed
CLOSE
END
END IF
RETURN

'============================ End of main module ============================

SUB BuildArray (PtrArray&(), Pgcount%) STATIC
'FileName$ is shared from the main module

MaxLines% = 66 'Maximum number of lines
Offset& = 1 'Start of file (seek point)
OPEN FileName$ FOR BINARY AS #1 LEN = 1 'Open file to check
TotalSize& = LOF(1) 'Get LEN of file so we don't read too far
FileLeft& = TotalSize& 'Setup a counter to show whats left
MemAvail& = FRE(FileName$) - 2048 'Check available string memory
IF MemAvail& < 2048 THEN ERROR 14 'Force out of memory error
SixteenK% = 16384

IF TotalSize& > SixteenK% THEN 'Set a buffer size
IF MemAvail& > SixteenK% THEN 'If the file is larger than 16K
BufSize& = SixteenK% 'Set it to 16k
ELSE
BufSize% = MemAvail&
END IF
ELSE
IF TotalSize& < MemAvail& THEN 'Otherwise set it to file size
BufSize& = TotalSize&
END IF
END IF

Pgcount% = 1 'Initialize page count
PtrArray&(Pgcount%) = 1 'First pointer is always 1
LnCount% = 0 'Initialize line count

GetPage:
'Read the file
IF FileLeft& < BufSize& THEN 'Check amount left to read
Buffer$ = SPACE$(FileLeft&) 'If less than our buffer, use lessor
ELSE
Buffer$ = SPACE$(BufSize&) 'Otherwise use full buffer size
END IF

GET #1, Offset&, Buffer$ 'Read in a buffers worth
StPtr% = 1 'Pointer into buffer$
LastLine% = 0 'remember last position

PageCheck:
TempLn% = INSTR(StPtr%, Buffer$, LF$) 'Position of next linefeed
TempPg% = INSTR(StPtr%, Buffer$, FF$) 'Position of next pagefeeds

IF TempPg% THEN 'If there was a page feed
IF TempPg% < TempLn% OR TempLn% = 0 THEN ' was it before our linefeed?
Pgcount% = Pgcount% + 1 ' yes then bump page count
PtrArray&(Pgcount%) = Offset& + TempPg% ' set next array element
StPtr% = TempPg% + 1 ' set instr pointer
LnCount% = 0 ' reset linecount
IF StPtr% < LEN(Buffer$) THEN GOTO PageCheck 'and loop back for more
END IF
END IF

IF TempLn% THEN 'Linefeed
IF PC.LineWrap THEN 'If /W the check line length
IF TempLn% - StPtr% > PC.LineLen THEN 'Greater than 80?
DO 'check for line wrap
LnCount% = LnCount% + 1 'increment line
IF LnCount% = MaxLines THEN GOTO PageBreak '> 66 lines
StPtr% = StPtr% + PC.LineLen
LOOP WHILE TempLn% - StPtr% > PC.LineLen
END IF
END IF
LnCount% = LnCount% + 1 'Increment page count

PageBreak:
IF LnCount% = MaxLines% THEN
Pgcount% = Pgcount% + 1
IF Pgcount% > 512 THEN
PRINT "Too may pages- printing only 512"
GOTO EndBuild
END IF
PtrArray&(Pgcount%) = Offset& + TempLn% 'point to next in point in file
LnCount% = 0
END IF
StPtr% = TempLn% + 1 'point ahead 1 byte for next scan

IF StPtr% <= LEN(Buffer$) THEN
GOTO PageCheck 'keep checking
END IF
END IF

Offset& = Offset& + LEN(Buffer$) 'Pointer into file (tally)
StPtr% = 1 'Reset Buffer pointer
FileLeft& = TotalSize& - Offset& 'Calculate how much is left
IF Offset& < TotalSize& THEN GOTO GetPage 'If more text in file, keep going

EndBuild:
PtrArray&(Pgcount% + 1) = TotalSize& 'Set last pointer to end of file

CLOSE #1 'Close input file

END SUB 'End of BuildArray Module

SUB DoMacro (Num$) STATIC
PRINT #2, ESC$; "&f"; Num$; "y2X"; 'execute the macro
END SUB

SUB EndMacro (Num$) STATIC
PRINT #2, ESC$; "&f"; Num$; "y1X"; 'Send end of macro command
PRINT #2, ESC$; "&f"; Num$; "y9X"; 'Make it temporary (10 to be permanent)
END SUB

SUB Header (Page%) STATIC
Hdr$ = SPACE$(PC.LineLen) 'Create a string to print
IF PC.FileTitle THEN 'Print the filename
MID$(Hdr$, 40 - LEN(FileName$) \ 2) = UCASE$(FileName$)
END IF

IF PC.PgNumber THEN 'Print the current page
PTemp$ = "Page" + STR$(Page%)
IF Page% MOD 2 THEN
MID$(Hdr$, PC.LineLen - LEN(PTemp$)) = PTemp$ 'odd page, right side
ELSE
MID$(Hdr$, 1) = PTemp$ 'even page, left side
END IF
END IF

IF PC.CurDate THEN 'Print the current date
IF Page% MOD 2 THEN
MID$(Hdr$, 1) = DATE$ 'even page, left side
ELSE
MID$(Hdr$, PC.LineLen - LEN(DATE$)) = DATE$ 'odd page, right side
END IF
END IF
PRINT #2, Hdr$ 'Print the Header
PRINT #2, ' and skip a line for readability

END SUB

SUB LJLocate (X%, Y%) STATIC 'Laser Jet cursor locate
Temp$ = ESC$ + "&a" + LTRIM$(STR$(Y%)) + "r" + LTRIM$(STR$(X%)) + "C"
PRINT #2, Temp$;
END SUB

SUB PrintLogo STATIC 'Banner logo
PRINT STRING$(80, 61)
PRINT "PCBook - PC Magazine Booklet Printing Utility"
PRINT "Copyright 1990 PC Magazine Ziff Davis Jay Munro"
PRINT STRING$(80, 61)
END SUB

SUB PrintSetup '============== Send codes to prepare printer
PRINT #2, ESC$; "E"; 'Reset laserjet (simple isn't it!)
PRINT #2, ESC$; "&l1o5.45C"; 'Select lineprinter font"
PRINT #2, ESC$; "(s0p16.66H"; ' and pitch
PRINT #2, ESC$; "&l0L"; 'Turn off page feed at 66 lines

IF PC.LineWrap THEN 'Wrap lines > 80 chars
PRINT #2, ESC$; "&s0C";
END IF

PRINT #2, ESC$; "&l2E"; 'Top margin 2 lines

CALL StartMacro("1") 'Left side macro
PRINT #2, ESC$; "9"; 'Reset left - right margins
PRINT #2, ESC$; "&a0l80M"; 'set left margin 0, right 80
CALL EndMacro("1")

CALL StartMacro("2") 'Right side macro
PRINT #2, ESC$; "9"; 'Reset left - right margins
PRINT #2, ESC$; "&a95l175M"; 'set left margin 95, right 175
CALL EndMacro("2")

END SUB

SUB StartMacro (Num$) STATIC
PRINT #2, ESC$; "&f"; Num$; "Y"; 'Macro will have an id of Num$
PRINT #2, ESC$; "&f0X"; 'Start the macro now
END SUB