home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol061 / dletters.asc < prev    next >
Encoding:
Text File  |  1984-04-29  |  5.6 KB  |  258 lines
  1. 1000 GOSUB 1930 'cs
  2. 1010 PRINT:PRINT TAB(28);"DLETTERS March 20, 1982
  3. 1015 ' by Dan Dugan -- public domain
  4. 1020 PRINT:PRINT"In this program you control printing in the same way that
  5. 1030 PRINT"you control listing on the screen in DEDIT.  The 'pause prompt'
  6. 1040 PRINT"Ready> will accept SPACE or RETURN to print, 'z' to print and keep
  7. 1050 PRINT"going without pausing, or ESCAPE to abort and return to DEDIT.
  8. 1051 PRINT:PRINT"It will also accept two commands special to the letters
  9. 1052 PRINT"program.  'r' will cause the previous letter to repeat, and
  10. 1053 PRINT"'n' will ask for a record number to start from.
  11. 1060 PRINT:PRINT"While printing without pause, hitting the space bar during
  12. 1070 PRINT"a letter will cancel the 'z' and cause the program to pause before
  13. 1080 PRINT"starting the next letter.
  14. 1090 ON ERROR GOTO 1780
  15. 1100 DEFINT A-Z
  16. 1110 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,
  17.     C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),
  18.     SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
  19. 1130 GOTO 1160
  20. 1140 PRINT:PRINT"Wait while editor program is re-loaded
  21. 1150 CHAIN DD$(1)+"DEDIT",1000
  22. 1160 '
  23.  
  24.  
  25.                 PRINT LETTER SET-UP
  26.  
  27. 1170 INPUT"Enter text file name (use prefix: to identify disk)"; G$
  28. 1180 IF G$="x" OR G$="" THEN 1670
  29. 1190 X$=G$: GOSUB 1810 ' UCV
  30. 1200 G$=Y$
  31. 1210 OPEN "I",3,G$ ' test
  32. 1220 CLOSE 3
  33. 1230 '
  34.  
  35.  
  36.  
  37.                 RECORD WORK LOOP
  38.  
  39. 1240 C2=0 ' first time
  40. 1250 '
  41. 1260 FOR I=T1 TO T2 '        <==== FOR
  42. 1270 GOSUB 2510 ' get rec
  43. 1280 IF ASC(T$)=0 THEN PRINT"0";:GOTO 1640
  44.     ELSE PRINT"+";
  45. 1290 T1$=T$ ' save it
  46. 1300 IF SKIPPARSE=1 THEN 1320
  47. 1310 GOSUB 1690 ' parse record string
  48. 1320 IF SEARCH=0 THEN 1620
  49. 1330 '
  50.  
  51.  
  52.                 SEARCH
  53.  
  54. 1340 IF SEARCH<>2 THEN 1410
  55. 1350 IF INSTR(T$,SEARCHWORD$(0))=0 THEN 1640
  56. 1360 '
  57.     speed search
  58. 1370 LPRINT CHR$(7); ' found it
  59. 1380 GOSUB 1690 ' parse
  60. 1390 GOTO 1620
  61. 1400 '
  62.     field search
  63. 1410 J=0 '            check for skips first
  64. 1420 IF SKIPWORD$(J)="" THEN 1500 ' try search then
  65. 1430 IF LOOKFIELD(J)<>0 THEN 1470 ' look in field
  66. 1440 IF INSTR(T1$,SKIPWORD$(J))<>0 THEN 1640
  67. 1450 J=J+1
  68. 1460 GOTO 1420
  69. 1470 IF INSTR(B$(LOOKFIELD(J)),SKIPWORD$(J))<>0 THEN 1640
  70. 1480 J=J+1
  71. 1490 GOTO 1420
  72. 1500 IF SEARCHWORD$(0)="" THEN 1600 ' don't care so print it
  73. 1510 J=0: GOTO 1530 '        now search
  74. 1520 IF SEARCHWORD$(J)="" THEN 1640
  75. 1530 IF SEARCHFIELD(J)<>0 THEN 1570 ' field
  76. 1540 IF INSTR(T1$,SEARCHWORD$(J))<>0 THEN 1600 ' found it
  77. 1550 J=J+1
  78. 1560 GOTO 1520
  79. 1570 IF INSTR(B$(SEARCHFIELD(J)),SEARCHWORD$(J))<>0 THEN 1600
  80. 1580 J=J+1
  81. 1590 GOTO 1520
  82. 1600 LPRINT CHR$(7);
  83. 1610 IF SKIPPARSE=1 THEN GOSUB 1690 ' parse
  84. 1620 '
  85.  
  86.                 zag to do it
  87. 1630 GOTO 1960
  88. 1640 '
  89.  
  90.                 END OF RECORD WORK LOOP
  91.  
  92. 1650 IPREV=I ' for repeat command
  93. 1660 NEXT
  94. 1670 '
  95.  
  96.                 FINISH
  97.  
  98. 1680 GOTO 1140 ' exit
  99. 1690 '
  100.  
  101.  
  102.  
  103.                 (SUB) PARSE STRING
  104.  
  105. 1700 K=0
  106. 1710 J=INSTR(T$,CHR$(126)) ' delimiter
  107. 1720 IF J=0 THEN RETURN
  108. 1730 K=K+1
  109. 1740 B$(K)=MID$(T$,1,J-1)
  110. 1750 T$=MID$(T$,J+1)
  111. 1760 GOTO 1710
  112. 1770 '
  113.  
  114.                 ERROR HANDLING
  115.  
  116. 1780 IF ERL=1210 AND ERR=53 THEN CLOSE 3:PRINT"FILE NOT FOUND": RESUME 1160
  117. 1790 IF ERL=1210 AND ERR=64 THEN CLOSE 3:PRINT"UNACCEPTABLE FILE NAME": RESUME 1160
  118. 1800 ON ERROR GOTO 0
  119. 1810 '
  120.  
  121.  
  122.                 (SUB) UCV
  123.  
  124. 1820 Y$=""
  125. 1830 FOR J=1 TO LEN(X$)
  126. 1840    Y$=Y$+" "
  127. 1850    X=ASC(MID$(X$,J, 1))
  128. 1860    IF 96<X AND X<123 THEN MID$(Y$,J,1)=CHR$(X-32): GOTO 1880
  129. 1870    MID$(Y$,J,1)=MID$(X$,J,1)
  130. 1880 NEXT J
  131. 1890 RETURN
  132. 1900 '
  133.  
  134.  
  135.                 (SUB) EXIT TEST
  136.                 returns char. in X
  137.  
  138. 1910 X$=INKEY$:X=0
  139. 1911 IF X$<>"" THEN X=ASC(X$)
  140. 1915 IF X=27 THEN CLOSE 3:GOTO 1670    ' use ESC to escape listing
  141. 1920 RETURN
  142. 1930 '
  143.  
  144.  
  145.                 (SUB) CLEAR SCREEN (TERM DEP)
  146.  
  147. 1940 PRINT CHR$(12);
  148. 1950 RETURN
  149. 1960 '
  150.  
  151.  
  152.                 PRINT LETTER (insert above)
  153.  
  154. 1970 '
  155.  
  156.         PAUSE CONTROLS        (TERM DEP if uppercase) 
  157.  
  158. 1980 GOSUB 1900 ' exit
  159. 2000 IF X=122 THEN 2090            ' go on
  160. 2010 PRINT I;B$(1);TAB(20);"Ready>";
  161. 2020 A$=INPUT$(1):PRINT A$
  162. 2030 IF A$=CHR$(13) OR A$=CHR$(32) THEN 2090
  163. 2040 IF A$="z" THEN 2090
  164. 2050 IF A$="r" THEN I=IPREV:GOTO 1270
  165. 2060 IF A$="n" THEN 2070 ELSE 2080
  166. 2070 INPUT"Enter number of desired record:  ";I:GOTO 1270
  167. 2080 GOTO 1970            ' loop
  168. 2090 '
  169.  
  170.         DO IT
  171.  
  172. 2100 C1=0        'counts data lines
  173. 2110 OPEN "I",3,G$ ' open each time to restore
  174. 2120 IF P9=0 THEN GOSUB 1930 ' clear screen
  175. 2130 IF EOF(3) THEN 2140 ELSE 2180
  176. 2140 '
  177.  
  178.         END OF TEXT FILE
  179.  
  180. 2150    IF P9=1 THEN LPRINT CHR$(12); ' form feed
  181. 2160    CLOSE 3
  182. 2170    GOTO 1640 ' next record
  183. 2180 '
  184.  
  185.         GET LINE & TEST
  186.  
  187. 2190 LINE INPUT #3,L$
  188. 2200 IF LEFT$(L$,3)=".da" THEN 2210 ELSE 2450
  189. 2210 '
  190.  
  191.         LINE IS DATA LINE
  192.  
  193. 2220 C1=C1+1:IF C1>NC THEN 2130
  194. 2230 ON C1 GOTO 2240, 2310, 2340, 2370, 2400, 2430 ' six lines
  195. 2240 '
  196.  
  197.         FIRST DATA LINE
  198.  
  199. 2250 IF B$(1)="" AND B$(2)="" THEN 2300
  200. 2260 IF B$(1)="" THEN A$=B$(2):GOTO 2300
  201. 2270 IF B$(2)="" THEN A$=B$(1):GOTO 2300
  202. 2280 A$=B$(2)+CHR$(32)+B$(1)
  203. 2290 GOSUB 2480
  204. 2300 GOTO 2130
  205. 2310 '
  206.  
  207.         DATA LINE 2
  208.  
  209. 2320 IF B$(3)="" THEN 2130
  210. 2330 A$=B$(3):GOSUB 2480:GOTO 2130
  211. 2340 '
  212.  
  213.         DATA LINE 3
  214.  
  215. 2350 IF B$(4)="" THEN 2130
  216. 2360 A$=B$(4):GOSUB 2480:GOTO 2130
  217. 2370 '
  218.  
  219.         DATA LINE 4
  220.  
  221. 2380 IF B$(5)="" THEN 2130
  222. 2390 A$=B$(5):GOSUB 2480:GOTO 2130
  223. 2400 '
  224.  
  225.         DATA LINE 5
  226.  
  227. 2410 A$=B$(6)+CHR$(32)+B$(7)
  228. 2420 GOSUB 2480:GOTO 2130
  229. 2430 '
  230.  
  231.         DATA LINE 6
  232.  
  233. 2440 A$=B$(10):GOSUB 2480:GOTO 2130
  234. 2450 '
  235.  
  236.         PRINT TEXT LINE
  237.  
  238. 2460 IF P9 THEN LPRINT L$ ELSE PRINT L$
  239. 2470 GOTO 2130
  240. 2480 '
  241.  
  242.         (SUB) PRINT DATA LINE
  243.  
  244. 2490 IF P9 THEN LPRINT A$ ELSE PRINT A$
  245. 2500 RETURN
  246. 2510 '
  247.  
  248.  
  249.                 GET RECORD "I" IN T$ SUB
  250.  
  251. 2520 T$="" ' necessary!
  252. 2530 ON FT GOTO 2560,2540
  253. 2540    GET#1,FT*I+2 ' latter half
  254. 2550    T$=LEFT$(R$,127)
  255. 2560    GET#1,FT*I+1 ' whole or first half
  256. 2570    T$=R$+T$
  257. 2580 RETURN
  258.