1000 '=====================================================================
1010 '                              P S R J   
1020 '=====================================================================
1030 '
1040 'A program to do proportionally-spaced, right-justified printing
1050 'originally written for the Canon AP400 typewriter and AP92 interface
1060 '
1070 'Copyright (c) 1985 Alan T. Chattaway           Phone (604) 432-9988
1080 'All rights reserved.  May not be distributed for commercial gain in
1090 'any way, without permission of the copyright owner.
1100 '_____________________________________________________________________
1110 '
1120 'Table of Control Characters which may be placed in the source file:
1130 'Note: these are the only control characters that can be placed in
1140 'the source file without WordStar creating problems when it prints
1150 'to its output file.
1160 '_____________________________________________________________________
1170 '
1180 '  CTRL-W  No Justification (at end of line only - ignored elsewhere)
1190 '  CTRL-R  Justification (at end of line only - ignored elsewhere)
1200 '
1210 '  CTRL-Q  Emphasised
1220 '  CTRL-E  End Emphasised
1230 '
1240 '  CTRL-C  Centre (at end of line only - ignored elsewhere)
1250 '
1260 '  CTRL-A  Bold
1270 '  CTRL-N  End Bold
1280 '
1290 '  CTRL-F  Underscore
1300 '  CTRL-G  End Underscore
1310 '
1320 '  CTRL-H  (Not Implemented Yet)
1330 '_____________________________________________________________________
1340 '
1350 'Defeat MBASIC's automatic carriage return after 80 characters
1360    WIDTH 255
1370    WIDTH LPRINT 255
1380 '
1390 'Set up table of character widths for Canon PS wheels (Modern, Cosmos)
1400    DIM ROOM(127)
1410       FOR CODE = 0 TO 127
1420       READ ROOM(CODE)
1430       NEXT CODE
1440 '
1450 '=====================================================================
1460 '||||||    Customize these lines for use with other hardware    ||||||
1470 '=====================================================================
1480 '
1490 'Set up strings that control this particular terminal
1500 '
1510    CLS$ = CHR$(26)                       '(clears terminal screen)
1520    BUZ$ = CHR$(7)                        '(sounds buzzer in terminal)
1530    GUP$ = CHR$(11) + CHR$(27) + CHR$(82) '(up screen 1 line & delete)
1540 '
1550 'Set up strings that control this particular printer
1560 '
1570    SIZE = 120                            '(microspaces per inch)
1580    RST$ = CHR$(27) + CHR$(26) + "I"      '(initializes printer)
1590    MCS$ = CHR$(27) + CHR$(31) + CHR$(2)  '(sets 1/SIZE spacing mode)
1600    EMP$ = CHR$(27) + "R"                 '(starts Emphasised print)
1610    NRM$ = CHR$(27) + "Q"                 '(ends Emphasised print)
1620    NMV$ = CHR$(27) + "N"                 '(don't move after next char)
1630    BEL$ = CHR$(7)                        '(sounds beeper in printer)
1640    CAR$ = CHR$(13)                       '(carriage return)
1650    FRM$ = CHR$(12)                       '(form feed)
1660 '
1670 'Initialize typewriter, set to microspacing mode and beep there
1680 '
1690    LPRINT RST$ + MCS$ + BEL$;
1700 '
1710 'Clear screen
1720    PRINT CLS$;
1730 '
1740 'Print greeting
1750    PRINT "==================================================="
1760    PRINT "|||||        P S R J       Version 1.1        |||||"
1770    PRINT "===================================================": PRINT
1780    PRINT "  Produces Proportionally-Spaced, Right-Justified  "
1790    PRINT "  text from WordStar files first printed to disk.  "
1800    PRINT "       Copyright (c) 1985  Alan T. Chattaway       "
1810    PRINT "                All Rights Reserved                "
1820    PRINT "==================================================="
1830 '
1840 'Get filename, line length and other parameters
1850    PRINT: PRINT "What is the NAME of the file to be printed?  "
1860    PRINT "Your file must have been `printed to disk' by "
1870    INPUT "WordStar and must be present on the disk in B:", FYLNAM$
1880       IF FYLNAM$ = "" OR LEFT$(FYLNAM$,1) = " " THEN GOTO 1710
1890       FOR PLACE = 1 TO LEN(FYLNAM$)
1900       HOLDING$ = MID$(FYLNAM$,PLACE,1)
1910       IF ASC(HOLDING$) < 97 THEN GOTO 1930
1920       MID$(FYLNAM$,PLACE,1) = CHR$(ASC(HOLDING$) AND 95)
1930       NEXT PLACE
1940    FYLNAM$ = "B:"+FYLNAM$
1950 '
1960    UP = 3: GOSUB 4780
1970    PRINT "Your file is "; FYLNAM$; ", is that correct? "
1980    PRINT "Press <ESC> if wrong, any other key if right."
1990    RESPONSE$ = INPUT$(1)
2000       IF RESPONSE$ = CHR$(27) THEN GOTO 1710
2010 '
2020    UP = 2: GOSUB 4780
2030    PRINT "What is the line length in inches?           "
2040    INPUT "Default = 6.5 inches (about 77 characters).  ", LYNLEN
2050       IF LYNLEN > 12 THEN LYNLEN = 12
2060       IF LYNLEN = 0 THEN LYNLEN = 6.5
2070       TOTSPAC = INT((LYNLEN * SIZE) + .5) '(microspaces per line)
2080 '
2090    UP = 2: GOSUB 4780
2100    PRINT "What is the page offset (left margin)?       "
2110    INPUT "Default = 0.8 inches, maximum = 2 inches.     ", OFFSET
2120       IF OFFSET > 2 THEN OFFSET = 2
2130       IF OFFSET = 0 THEN OFFSET = .8
2140       MARGIN$ = SPACE$(SIZE * OFFSET)
2150 '
2160    UP = 2: GOSUB 4780
2170    PRINT "What is the page length, in lines including  "
2180    INPUT "top and bottom margins (default 66 lines)?   ", LYNES
2190       IF LYNES > 112 THEN LYNES = 112
2200       IF LYNES = 0 THEN LYNES = 66
2210       LYNCOUNT = 0
2220 '_____________________________________________________________________
2230 '
2240 'Start working here; first, strip 8th. bits from all characters
2250    PRINT CLS$ + "Has this file been filtered previously to remove"
2260    PRINT "the 8th. bit from each character? If not, this
2270    PRINT "program must do so before trying to print the file.": PRINT
2280    PRINT "Press <ESC> to skip, any other key to filter file."
2290    RESPONSE$ = INPUT$(1)
2300    IF RESPONSE$ = CHR$(27) THEN GOTO 2630
2310 '
2320 'Start filtering the file
2330    PRINT CLS$ + "<<< Filtering file "; FYLNAM$; "!  Do not disturb! >>>"
2340    PRINT
2350    RESET : SECTORNUM = 1
2360    OPEN "R", #1, FYLNAM$, 128
2370	FIELD #1, 128 AS SCTR$
2380    PRINT "Filtering Sector #"; SECTORNUM
2390    GET #1, SECTORNUM
2400    SECTOR$ = SCTR$
2410       FOR PLACE = 1 TO 128
2420       CHAR$ = MID$(SECTOR$,PLACE,1)
2430       IF CHAR$ = CHR$(15) THEN CHAR$ = " " 'non-break space
2440       IF CHAR$ = CHR$(31) THEN CHAR$ = "-" 'soft hyphen
2450       MID$(SECTOR$,PLACE,1) = CHR$(ASC(CHAR$) AND 127)
2460       IF CHAR$ = CHR$(26) THEN EOFLAG = 1: GOTO 2480
2470       NEXT PLACE
2480    LSET SCTR$ = SECTOR$
2490    PUT #1, SECTORNUM
2500    IF EOFLAG = 1 THEN GOTO 2520
2510    SECTORNUM = SECTORNUM + 1: GOTO 2380
2520    CLOSE #1
2530 '
2540 'Offer opportunity to quit
2550    PRINT "File "; FYLNAM$; " successfully filtered."
2560    PRINT "Press <ESC> to quit, any other key to print file."
2570    RESPONSE$ = INPUT$(1)
2580    IF RESPONSE$ <> CHR$(27) THEN GOTO 2630
2590    PRINT: PRINT: PRINT "Program terminated at operator's request"
2600    END
2610 '_____________________________________________________________________
2620 '
2630    PRINT CLS$;: PRINT "Enter the number of the first page you want to "
2640    INPUT "print, or press <Return> if Page 1 is wanted. ", PAGNUM
2650    IF PAGNUM = 0 THEN PAGNUM = 1
2660    SKIPLYNES = ((PAGNUM - 1) * LYNES)
2670    PRINT: PRINT "<<< Printing file "; FYLNAM$; "!  Do not disturb! >>>"
2680    PRINT
2690 '
2700 'Open the file for sequential line output
2710    OPEN "I", #1, FYLNAM$
2720 '
2730 'Check for End-Of-File; if so, eject paper and stop program
2740    IF EOF(1) THEN GOTO 2750 ELSE GOTO 2780
2750    PRINT: PRINT: PRINT "File "; FYLNAM$; " successfully printed."
2760    CLOSE: LPRINT CAR$ + FRM$;: END
2770 '
2780 'Get one line from the file and increment line counter
2790    LINE INPUT#1, LYN$
2800    LYNCOUNT = LYNCOUNT + 1
2810    IF SKIPLYNES = -1 THEN GOTO 2850
2820    IF SKIPLYNES = 0 THEN SKIPLYNES = -1: GOTO 2940
2830    SKIPLYNES = SKIPLYNES - 1: GOTO 2790
2840 '
2850 'Check for end of page using integer division and finite difference
2860 '(This method of comparison gets around round-off errors in MBASIC)
2870    PREVLYN = LYNCOUNT - 1
2880    IF ABS(PREVLYN\LYNES - PREVLYN/LYNES) > .001 THEN GOTO 2940
2890    PRINT: PRINT BUZ$: PRINT "Insert another sheet of paper, and press
2900    PRINT "any key, or <ESC> to quit printing now."
2910    RESPONSE$ = INPUT$(1): IF RESPONSE$ = CHR$(27) THEN GOTO 2590
2920    PRINT CLS$ + "<<< Printing!  Do not disturb! >>>"
2930 '
2940 'If line empty, print it and return for another
2950    IF LYN$ <> "" THEN GOTO 2980
2960    LPRINT: GOTO 2730
2970 '
2980 'Trim any redundant blanks from end of line
2990       WHILE RIGHT$(LYN$,1) = " "
3000       LYN$ = LEFT$(LYN$,(LEN(LYN$)-1))
3010       WEND
3020 '
3030 'Trim CTRL-C character from START of line (WordStar page break)
3040    IF LEFT$(LYN$,1) <> CHR$(3) THEN GOTO 3070
3050    LYN$ = RIGHT$(LYN$,(LEN(LYN$) - 1))
3060 '
3070 'If line ends in a "Justify-CENTRE" marker (CTRL-C), trim left spaces
3080    IF RIGHT$(LYN$,1) <> CHR$(3) THEN GOTO 3280
3090       LYN$ = LEFT$(LYN$,(LEN(LYN$)-1))
3100          WHILE LEFT$(LYN$,1) = " "
3110          LYN$ = RIGHT$(LYN$,(LEN(LYN$)-1))
3120          WEND
3130 '
3140 'Find length of printable part of centered line
3150       TOTROOM = 0: THISROOM = 0
3160          FOR PLACE = 1 TO LEN(LYN$)
3170          THISROOM = ROOM(ASC(MID$(LYN$,PLACE,1)))
3180          TOTROOM = TOTROOM + THISROOM
3190          NEXT PLACE
3200 '
3210 'Calculate spaces needed to centre line, add them, and print line
3220       SPAC = (TOTSPAC - TOTROOM + .5) \ 2
3230       SPACHAR = (SPAC + .5) \ ROOM(32)
3240       LYN$ = SPACE$(SPACHAR) + LYN$
3250       NOJUST = 1 :GOSUB 3930: NOJUST = 0
3260       GOTO 2730
3270 '
3280 'If line ends in a "No Justify" marker (CTRL-W), print it "as is"
3290    IF RIGHT$(LYN$,1) <> CHR$(23) THEN GOTO 3340
3300       LYN$ = LEFT$(LYN$,(LEN(LYN$)-1))
3310       NOJUST = 1: GOSUB 3930: NOJUST = 0
3320    GOTO 2730
3330 '
3340 'Count room taken by non-space characters and by space characters,
3350 'as well as total number of spaces in the line
3360    TOTROOM = 0: THISROOM = 0: CHAR$ = "": CODE = 0: NUMSPAC = 0
3370       FOR PLACE = 1 TO LEN(LYN$)
3380       CHAR$ = MID$(LYN$,PLACE,1)
3390       CODE = ASC(CHAR$)
3400       THISROOM = ROOM(CODE)
3410          IF CODE <> 32 THEN TOTROOM = TOTROOM + THISROOM: GOTO 3430
3420          NUMSPAC = NUMSPAC + 1
3430       NEXT PLACE
3440 '
3450 'If line ends in a "Do Justify" marker (CTRL-R), then justify it
3460    IF RIGHT$(LYN$,1) <> CHR$(18) THEN GOTO 3500
3470    LYN$ = LEFT$(LYN$,(LEN(LYN$)-1))
3480    GOTO 3560
3490 '
3500 'Don't justify lines having only one word
3510    IF NUMSPAC = 0 THEN GOTO 3310
3520 '
3530 'Don't justify lines that are deeply indented (address of letter)
3540    IF LEFT$(LYN$,20) = SPACE$(20) THEN GOTO 3310
3550 '
3560 'Calculate microspaces available for each space character
3570    MICROS = (TOTSPAC - TOTROOM) \ NUMSPAC
3580 '
3590 'Assume that if spaces are too wide, line not to be justified
3600    IF MICROS > 2 * ROOM(32) THEN GOTO 3310
3610    WIDESPAC$ = SPACE$(MICROS)
3620 '
3630 'Deal with leftover microspaces due to integer division above
3640    SPARES = (TOTSPAC - TOTROOM) - (MICROS * NUMSPAC)
3650 '
3660 'Now print the line
3670    NOJUST = 0
3680    GOSUB 3930
3690 '
3700 'End of line; go back for another line
3710    GOTO 2730
3720 '
3730 '=====================================================================
3740 '|||||||   Change this table if using a different printwheel!   ||||||
3750 '=====================================================================
3760 '
3770 'Table of character widths follows (for Canon PS printwheels).
3780 'The 128 characters are in ASCII order from NUL to DEL; widths are
3790 'given in 1/(SIZE)ths. of an inch and MUST be an EVEN NUMBER!
3800 '
3810     DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
3820     DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
3830     DATA 10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10
3840     DATA 10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10
3850     DATA 10,12,12,12,12,12,12,12,12,8,10,12,12,14,12,12
3860     DATA 12,12,12,10,12,12,12,14,12,12,10,10,8,10,10,10
3870     DATA 10,10,12,10,12,10,8,10,12,8,8,12,8,14,10,10
3880     DATA 12,12,10,10,8,10,12,14,12,12,10,10,10,10,10,0
3890 '
3900 'End of program; subroutines follow
3910 '_____________________________________________________________________
3920 '
3930 'SUBROUTINE to print a line, either justified or non-justified
3940 'Start to print the line; first the left margin
3950    LPRINT MARGIN$;
3960 '
3970 'This section prints characters of correct proportional width
3980    SPACLEFT = NUMSPAC
3990       FOR PLACE = 1 TO LEN(LYN$)
4000       CHAR$ = MID$(LYN$,PLACE,1)
4010       CODE = ASC(CHAR$)
4020 '
4030 'Handling of control characters for special effects
4040       IF CODE = 5 THEN LPRINT EMP$;    'CTRL-Q
4050       IF CODE = 17 THEN LPRINT NRM$;   'CTRL-E
4060 '
4070       IF CODE = 1 THEN BLDFACE = 1     'CTRL-A
4080       IF CODE = 14 THEN BLDFACE = 0    'CTRL-N
4090 '
4100       IF CODE = 6 THEN UNDSCOR = 1     'CTRL-F
4110       IF CODE = 7 THEN UNDSCOR = 0     'CTRL-G
4120 '
4130 'Control characters are not to be sent to the printer
4140       IF CODE < 32 THEN GOTO 4650
4150 '
4160 'Spaces are handled by a different section of this subroutine
4170       IF CODE = 32 THEN GOTO 4370
4180       THISROOM = ROOM(CODE)
4190       SIDECHAR$ = SPACE$(THISROOM/2)
4200 '
4210 'Print left half of char's room, then character itself
4220       LPRINT SIDECHAR$;
4230       LPRINT CHAR$;: GOSUB 4730
4240 '
4250 'Check for boldface; if required, do it now
4260 'but first, check for underscore and set "no move"
4270       IF UNDSCOR = 1 THEN LPRINT NMV$;
4280       IF BLDFACE = 1 THEN LPRINT CHAR$;: GOSUB 4730
4290 '
4300 'Now check again for underscore; if required, do it now
4310       IF UNDSCOR = 1 THEN LPRINT "_";
4320 '
4330 'Finish printing the character's room and go get next character
4340       LPRINT SIDECHAR$;
4350       GOTO 4650 '(returns to repeat the loop)
4360 '
4370 'This section prints spaces of correct width for each case
4380 'If line not to be justified, all spaces are standard width
4390       IF NOJUST = 1 THEN WIDESPAC$ = SPACE$(ROOM(32)): GOTO 4500
4400 '
4410 'Use up spare microspaces left by integer division
4420       IF SPARES = 0 THEN GOTO 4500
4430       LPRINT " ";: SPARES = SPARES - 1
4440       IF SPARES > SPACLEFT THEN LPRINT " ";: SPARES = SPARES - 1
4450       IF SPARES > (2 * SPACLEFT) THEN LPRINT " ";: SPARES = SPARES - 1
4460       IF SPARES > (3 * SPACLEFT) THEN LPRINT " ";: SPARES = SPARES - 1
4470       IF SPARES > (4 * SPACLEFT) THEN LPRINT " ";: SPARES = SPARES - 1
4480       IF SPARES > (5 * SPACLEFT) THEN LPRINT " ";: SPARES = SPARES - 1
4490 '
4500 'Now print a space of calculated width, and decrement space counter;
4510 'but first check whether underscores are required, act accordingly
4520       IF UNDSCOR = 0 THEN GOTO 4620
4530          THISPAC$ = WIDESPAC$
4540          IF LEN(THISPAC$) <= ROOM(32) THEN GOTO 4580
4550          FRONT = ROOM(32) \ 2: BACK = ROOM(32) - FRONT - 1
4560          LPRINT SPACE$(FRONT);: LPRINT "_";: LPRINT SPACE$(BACK);
4570          THISPAC$ = SPACE$(LEN(THISPAC$) - ROOM(32))
4580          FRONT = LEN(THISPAC$)\2: BACK = LEN(THISPAC$) - FRONT - 1
4590          LPRINT SPACE$(FRONT);: LPRINT "_";: LPRINT SPACE$(BACK);
4600          GOTO 4630
4610 '
4620       LPRINT WIDESPAC$;
4630       SPACLEFT = SPACLEFT - 1
4640 '
4650 'Get next character in line and continue printing
4660       NEXT PLACE
4670 '
4680 'End of subroutine
4690    LPRINT
4700    RETURN
4710 '_____________________________________________________________________
4720 '
4730 'SUBROUTINE decrementing room on char's right (allows for char itself)
4740    SIDECHAR$ = LEFT$(SIDECHAR$,(LEN(SIDECHAR$)-1)) 
4750    RETURN
4760 '_____________________________________________________________________
4770 '
4780 'SUBROUTINE to clear messages off screen line by line
4790    FOR GOINGUP = 1 TO UP: PRINT GUP$;: NEXT GOINGUP
4800    RETURN
4810 '_____________________________________________________________________
TO UP: PRINT GUP$;: NEXT GOI