home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug003.ark / FORMAT.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  3.7 KB  |  129 lines

  1. 1 REM $$$ FORMAT $$$  B.RATOFF  8/22/77
  2. REM A SIMPLE TEXT PROCESSING PROGRAM
  3. GOSUB 900
  4. GOSUB 730
  5. 50 NL=1
  6. 60 LO$=""
  7. 70 REM GET NEXT STRING AND CHECK FOR END OF DATA FLAG (..)
  8. READ#1;LI$
  9. IF END#1 THEN 800
  10. IF LEN(LI$)=0 THEN GOSUB 1200 : GOTO 70
  11. IF LEFT$(LI$,2)<>"QQ" THEN 77
  12. IF LEN(LO$)>0 THEN GOSUB 1200
  13. IF LEFT$(LI$,3)="QQJ" THEN JU$=MID$(LI$,4,1) : GOTO 70
  14. IF LEFT$(LI$,3)="QQF" THEN FI$=MID$(LI$,4,1) : GOTO 70
  15. IF LI$="QQP" THEN GOSUB 700 : NL=1 : LO$="" : GOTO 70
  16. IF LEFT$(LI$,3)="QQS" THEN GOSUB 1000 : GOTO 70
  17. IF LI$="QQC" THEN GOSUB 1100 : GOTO 70
  18. 77 GOSUB 400
  19. IF FI$="N" THEN LO$=LI$ : GOSUB 1200 : GOTO 70
  20. SC=1 : EC=LEN(LI$)
  21. 80 REM ANY WORDS LEFT IN STRING?
  22. IF SC>EC THEN 70
  23. 150 REM GET NEXT WORD. NULL STRING IN W$ MEANS READ SOME MORE
  24. GOSUB 300
  25. IF W$="" THEN 70
  26. 160 REM WILL THIS WORD FIT ON THE CURRENT LINE?
  27. IF LEN(LO$)+LEN(W$)>PW-1 THEN 200
  28. REM IT FITS, SO ADD IT, INCL A SPACE IF NOT THE FIRST WORD
  29. IF LEN(LO$)>0 THEN LO$=LO$+" "
  30. LO$=LO$+W$
  31. GOTO 80
  32. 200 REM COME HERE WITH A FULL LINE TO JUSTIFY AND PRINT IT
  33. GOSUB 500
  34. 210 REM CALL THE BREAK ROUTINE
  35. GOSUB 1200 : GOTO 160
  36. 300 REM ROUTINE TO MOVE NEXT WORD FROM LI$ TO W$
  37. REM RETURNS THE NULL STRING IN W$ IF LI$ IS USED UP
  38. W$="" : EW=SC
  39. 310 IF MID$(LI$,SC,1)<>" " THEN 350
  40. SC=SC+1 : EW=SC
  41. IF SC<=EC THEN GOTO 310 ELSE RETURN
  42. 350 EW=EW+1
  43. 360 IF EW>EC THEN 380
  44. IF MID$(LI$,EW,1)<>" " THEN 350
  45. 380 W$=MID$(LI$,SC,EW-SC) : SC=EW : RETURN
  46. 400 REM ROUTINE TO CONVERT ALPHAS NOT PRECEDED BY "^" TO LC
  47. LT$=""
  48. FOR J=1 TO LEN(LI$)
  49. LC$=MID$(LI$,J,1)
  50. IF LC$<"A" OR LC$="\" THEN LT$=LT$+LC$ : GOTO 470
  51. IF LC$<>"^" THEN 460
  52. LT$=LT$+CHR$(ASC(MID$(LI$,J+1,1)) AND NOT 32) : J=J+1 : GOTO 470
  53. 460 LT$=LT$+CHR$(ASC(LC$) OR 32)
  54. 470 NEXT J
  55. LI$=LT$
  56. RETURN
  57. 500 REM ROUTINE TO JUSTIFY A LINE BY WIDENING WORD SPACING
  58. IF JU$="N" THEN RETURN
  59. IF LEN(LO$)>=PW OR LEN(LO$)<2 THEN 570
  60. REM SCAN LINE FROM RIGHT TO LEFT (IT LOOKS BETTER)
  61. FOR J=LEN(LO$) TO 2 STEP -1
  62. REM ADD SPACE AT EACH WORD BOUNDARY;
  63. IF MID$(LO$,J,1)<>" " OR MID$(LO$,J+1,1)=" " THEN 550
  64. LO$=LEFT$(LO$,J)+MID$(LO$,J,255)
  65. REM QUIT AS SOON AS LINE IS CORRECT LENGTH (PW)
  66. IF LEN(LO$)>=PW THEN J=2
  67. 550 NEXT J
  68. REM MAKE ANOTHER PASS IF IT'S STILL TOO SHORT
  69. 560 GOTO 500
  70. 570 RETURN
  71. 600 REM ROUTINE TO CONVERT SPECIAL SYMBOLS:
  72. IF LEN(LO$)=0 THEN RETURN
  73. LT$=""
  74. FOR J=1 TO LEN(LO$)
  75. LC$=MID$(LO$,J,1)
  76. IF LC$="\" THEN LT$=LT$+" " : GOTO 610
  77. LT$=LT$+LC$
  78. 610 NEXT J
  79. LO$=LT$
  80. RETURN
  81. 700 REM ROUTINE FOR END OF PAGE
  82. IF NL+((PS-PP)/2)+1 > PS THEN 730
  83. FOR I=NL+((PS-PP)/2)+1 TO PS:PRINT:NEXT I
  84. REM IF PAUSE, RING BELL AND WAIT FOR 1 CHAR. FROM KEYBOARD
  85. 730 IF PU$="Y" THEN PRINT CHR$(7):OUT 255,0:GOSUB 750
  86. IF PS-PP>1 THEN FOR QQ=1 TO (PS-PP)/2:PRINT:NEXT QQ
  87. 740 RETURN
  88. 750 REM WAIT FOR A CHARACTER ON CONSOLE "T"
  89. IF (INP(0) AND 1)=1 THEN 750
  90. QQ=INP(1)
  91. RETURN
  92. 800 REM ROUTINE TO HANDLE LAST PAGE
  93. GOSUB 600
  94. PRINT LO$
  95. GOSUB 700
  96. GOTO 999999
  97. 900 REM ROUTINE TO REQUEST AND CHECK PARAMETERS
  98. INPUT "INPUT FILENAME";IFILE$
  99. FILE IFILE$
  100. INPUT "TOTAL LINES PER PAGE";PS
  101. 910 INPUT "PRINT LINES PER PAGE";PP
  102. IF PP>PS THEN PRINT "INVALID":GOTO 910
  103. 930 INPUT "PAUSE AFTER EA. PAGE";PU$
  104. PU$=LEFT$(PU$,1)
  105. IF PU$<>"Y" AND PU$<>"N" THEN PRINT "INVALID":GOTO 930
  106. INPUT "CHARACTERS PER LINE ";PW
  107. RETURN
  108. 1000 REM THIS ROUTINE HANDLES THE "QQS" (SKIP LINES) COMMAND
  109. QQS=VAL(MID$(LI$,4,255))
  110. IF QQS < 1 THEN RETURN
  111. IF QQS + NL > PP THEN GOSUB 700 : NL=1 : RETURN
  112. NL=NL+QQS
  113. FOR QQQ=1 TO QQS : PRINT : NEXT QQQ
  114. RETURN
  115. 1100 REM THIS ROUTINE CENTERS THE NEXT LINE ON THE PAGE
  116. READ#1;LI$ : GOSUB 400
  117. QQC=INT((PW-LEN(LI$))/2)
  118. LO$=LI$ : GOSUB 600
  119. PRINT TAB(QQC);LO$
  120. GOSUB 1250
  121. RETURN
  122. 1200 REM LINE BREAK ROUTINE
  123. GOSUB 600 : PRINT LO$
  124. 1250 NL=NL+1 : OUT 255,(NOT NL) AND 255
  125. IF NL>PP THEN NL=PP : GOSUB 700 : NL=1
  126. LO$=""
  127. RETURN
  128. 999999 END
  129.