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