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