home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / database / dims103.ark / DLABELS.ASC < prev    next >
Encoding:
Text File  |  1986-12-07  |  5.5 KB  |  219 lines
  1. 10 PRINT"This program must be entered from DEDIT.":STOP
  2. 1000 GOSUB 2060 'cs
  3. 1010 PRINT:PRINT TAB(25);"DLABELS 1.02 - October 17, 1982
  4. 1015 ' by Dan Dugan -- public domain
  5. 1020 PRINT
  6. 1030 DEFINT A-Z
  7. 1040 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,
  8.  
  9.     C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),
  10.  
  11.     SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
  12. 1060 '
  13.  
  14.  
  15.  
  16.                 SET-UP LABELS
  17. 1070 PRINT:PRINT"Please indicate the form that this list is in:
  18. 1080 PRINT:PRINT"     1.  Short form, (NAME, N2, ADDR, C-ST, ZIP)
  19. 1085 PRINT"     2.  Standard form, (LNAM, FNAM, N2, ADDR, C-ST, ZIP)
  20. 1090 PRINT"     3.  Long form, (LNAM, FNAM, TITL, ORG, ADDR etc.)
  21. 1100 PRINT:PRINT"Enter 1, 2 or 3:  ";
  22. 1110 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="1"
  23. 1120 PRINT A$: A=VAL(A$): IF A=0 THEN 1740
  24. 1125 IF A<1 OR A>3 THEN 1100
  25. 1130 PL=A-1
  26. 1140 GOSUB 1870 ' align labels
  27. 1150 '
  28.  
  29.  
  30.  
  31.  
  32.                 RECORD WORK LOOP
  33.  
  34.  
  35. 1160 C2=0 ' first time
  36. 1170 LC=0 ' count
  37. 1180 '
  38. 1190 FOR I=T1 TO T2 '        <==== FOR
  39. 1200 GOSUB 2210 ' get rec
  40. 1205 IF ASC(T$)=0 THEN PRINT"0";:GOTO 1720
  41. 1210 PRINT"+";
  42. 1220 T1$=T$ ' save it
  43. 1230 IF SKIPPARSE=1 THEN 1250
  44. 1240 GOSUB 1780 ' parse record string
  45. 1250 IF SEARCH=0 THEN 1540
  46. 1260 '
  47.  
  48.  
  49.  
  50.                 SEARCH
  51.  
  52.  
  53. 1270 IF SEARCH<>2 THEN 1320
  54. 1275 '
  55.  
  56.  
  57.         FIND
  58.  
  59.  
  60. 1280 IF INSTR(T$,SEARCHWORD$(0))=0 THEN 1720
  61. 1300 GOSUB 1780 ' parse
  62. 1310 GOTO 1540
  63. 1320 '
  64.  
  65.  
  66.         FIELD SEARCH
  67.  
  68.  
  69. 1330 J=0 '            check for skips first
  70. 1340 IF SKIPWORD$(J)="" THEN 1420 ' try search then
  71. 1350 IF LOOKFIELD(J)<>0 THEN 1390 ' look in field
  72. 1360 IF INSTR(T1$,SKIPWORD$(J))<>0 THEN 1720 ' whole rec search - skip it
  73. 1370 J=J+1
  74. 1380 GOTO 1340
  75. 1390 IF INSTR(B$(LOOKFIELD(J)),SKIPWORD$(J))<>0 THEN 1720 ' field compare - skip
  76. 1395 IF B$(LOOKFIELD(J))="" AND SKIPWORD$(J)="_" THEN 1720    'blank
  77. 1400 J=J+1
  78. 1410 GOTO 1340
  79. 1420 IF SEARCHWORD$(0)="" THEN 1520 ' don't care so print it
  80. 1430 J=0: GOTO 1450 '        now search
  81. 1440 IF SEARCHWORD$(J)="" THEN 1720 ' hesitate no longer
  82. 1450 IF SEARCHFIELD(J)<>0 THEN 1490 ' field
  83. 1460 IF INSTR(T1$,SEARCHWORD$(J))<>0 THEN 1520 ' found it
  84. 1470 J=J+1
  85. 1480 GOTO 1440
  86. 1490 IF INSTR(B$(SEARCHFIELD(J)),SEARCHWORD$(J))<>0 THEN 1520
  87. 1495 IF B$(SEARCHFIELD(J))="" AND SEARCHWORD$(J)="_" THEN 1520
  88. 1500 J=J+1
  89. 1510 GOTO 1440
  90. 1520 '
  91.  
  92.  
  93.         GET READY TO DO IT
  94.  
  95.  
  96. 1530 IF SKIPPARSE=1 THEN GOSUB 1780 ' parse
  97. 1540 '
  98.  
  99.  
  100.  
  101.                 PAUSE CONTROLS (TERM DEP IF UPPERCASE ONLY)
  102.  
  103.  
  104. 1541 GOSUB 2030            ' exit returns A
  105. 1542 IF A=122 THEN 1560        ' z means go on
  106. 1543 PRINT I;B$(1);TAB(30);"Ready (SPACE/z/r/n/ESC) >";
  107. 1544 A$=INPUT$(1):A=ASC(A$):IF A=27 THEN CLOSE 3:GOTO 1740
  108. 1545 PRINT A$:IF A=13 OR A=32 OR A=122 THEN 1560
  109. 1546 IF A=114 THEN I=IPREV:GOTO 1200 ' r
  110. 1547 IF A=110 THEN 1548 ELSE 1540 ' n or loop
  111. 1548 INPUT"Enter number of desired record:  ";I:GOTO 1200
  112. 1550 GOSUB 2030            ' exit
  113. 1560 '
  114.  
  115.  
  116.  
  117.                 PRINT LABEL
  118.  
  119.  
  120. 1562 LC=LC+1:IPREV=I
  121. 1570 IF PL=1 THEN GOSUB 2290    ' reformat medium to short form
  122. 1575 IF PL=2 THEN GOSUB 2090    ' reformat long to short form
  123. 1580 IF P9=0 THEN PRINT
  124. 1590 PRINT"("I")"
  125. 1600 T3=0 ' counts blank lines
  126. 1610 FOR J=1 TO 3
  127. 1620 IF B$(J)="" OR B$(J)=" " THEN T3=T3+1: GOTO 1640
  128. 1630    IF P9=1 THEN LPRINT B$(J) ELSE PRINT B$(J)
  129. 1640 NEXT J
  130. 1650 IF P9=1 THEN LPRINT B$(4); ELSE PRINT B$(4);
  131. 1660 IF P9=1 THEN IF LPOS(0)<15 THEN LPRINT TAB(15);
  132. 1670 IF P9=0 THEN IF POS(0)<15 THEN PRINT TAB(15);
  133. 1680 IF P9=1 THEN LPRINT" "B$(5) ELSE PRINT" "B$(5)
  134. 1690 FOR J=1 TO T3+2
  135. 1700    IF P9=1 THEN LPRINT ELSE PRINT
  136. 1710 NEXT J
  137. 1720    GOSUB 2030 ' check exit
  138. 1730 NEXT I '            END OF RECORD WORK LOOP
  139. 1740 '
  140.  
  141.  
  142.                 FINISH
  143.  
  144.  
  145. 1750 IF P9 THEN LPRINT"count:"LC:FOR J=1 TO 5:LPRINT:NEXT
  146. 1760 PRINT:PRINT:PRINT TAB(32)"Re-loading DEDIT.
  147. 1770 CHAIN DD$(1)+"DEDIT",1000
  148. 1780 '
  149.  
  150.  
  151.  
  152.  
  153.                 (SUB) PARSE STRING
  154.  
  155.  
  156. 1790 K=0
  157. 1800 M=INSTR(T$,CHR$(126)) ' delimiter
  158. 1810 IF M=0 THEN RETURN
  159. 1820 K=K+1
  160. 1830 B$(K)=""
  161. 1840 B$(K)=MID$(T$,1,M-1)
  162. 1850 T$=MID$(T$,M+1)
  163. 1860 GOTO 1800
  164. 1870 '
  165.  
  166.  
  167.                 (SUB) ALIGN LABELS
  168.  
  169.  
  170. 1880 PRINT"Print test label?  (y/n) ";
  171. 1890 A$=INPUT$(1): PRINT A$: IF A$=CHR$(13) THEN A$="y"
  172. 1900 IF A$="n" THEN RETURN
  173. 1910 IF A$<>"y" THEN 1880
  174. 1920 A$(1)="<------- Dan Dugan Sound Design ------>" ' 39 wide
  175. 1930 A$(2)="File:  "+F$+"    Date:"
  176. 1940 A$(3)="Selection:"
  177. 1950 IF P9 THEN LPRINT A$(1) ELSE PRINT A$(1)
  178. 1960 IF P9 THEN LPRINT A$(2) ELSE PRINT A$(2)
  179. 1970 IF P9 THEN LPRINT A$(3) ELSE PRINT A$(3)
  180. 1980 IF P9 THEN LPRINT A$(1) ELSE PRINT A$(1)
  181. 1990 FOR J=1 TO 2
  182. 2000    IF P9=1 THEN LPRINT ELSE PRINT
  183. 2010 NEXT J
  184. 2020 GOTO 1870
  185. 2030 '
  186.  
  187.  
  188.  
  189.                 (SUB) EXIT TEST (TERM DEP)
  190.  
  191.  
  192. 2040 X$=INKEY$
  193. 2042 IF X$<>"" THEN A=ASC(X$)
  194. 2045 IF A=27 THEN CLOSE 3:GOTO 1740    'use ESC to escape listing
  195. 2050 RETURN
  196. 2060 '
  197.  
  198.  
  199.  
  200.                 (SUB) CLEAR SCREEN (TERM DEP)
  201.  
  202.  
  203. 2070 PRINT CHR$(12);
  204. 2080 RETURN
  205. 2090 '
  206.  
  207.  
  208.                 (SUB) LONG FORM LABEL RE-FORMAT
  209.  
  210.  
  211. 2100 IF B$(1)="" AND B$(2)="" OR B$(3)="" THEN 2190
  212. 2110 IF B$(2)="" THEN B$(1)=B$(1)+", "+B$(3): GOTO 2130
  213. 2120 B$(1)=B$(2)+" "+B$(1)+", "+B$(3)
  214. 2130    IF LEN(B$(1))>39 THEN B$(1)=LEFT$(B$(1),39)
  215. 2140 B$(2)=B$(4)
  216. 2150 B$(3)=B$(5)
  217. 2160 B$(4)=B$(6)
  218. 2170 B$(5)=B$(7)
  219. 2180 RETURN
  220. 2190 IF B$(2)+B$(1)="" THEN B$(1)=B$(3) ELSE
  221.  
  222.     IF B$(2)="" THEN B$(1)=B$(1) ELSE
  223.  
  224.     B$(1)=B$(2)+" "+B$(1)
  225. 2200 GOTO 2130
  226. 2210 '
  227.  
  228.  
  229.  
  230.                 (SUB) GET RECORD "I" IN T$
  231.  
  232.  
  233. 2220 T$="" ' necessary!
  234. 2230 ON FT GOTO 2260,2240
  235. 2240    GET#1,FT*I+2 ' latter half
  236. 2250    T$=LEFT$(R$,127)
  237. 2260    GET#1,FT*I+1 ' whole or first half
  238. 2270    T$=R$+T$
  239. 2280 RETURN
  240. 2290 '
  241.  
  242.  
  243.                 (SUB) MEDIUM FORM RE-FORMAT
  244.  
  245.  
  246. 2300 B$(1)=B$(2)+" "+B$(1)
  247. 2310 B$(2)=B$(3)
  248. 2320 B$(3)=B$(4)
  249. 2330 B$(4)=B$(5)
  250. 2340 B$(5)=B$(6)
  251. 2350 RETURN
  252.  RE-FORMAT
  253.  
  254.  
  255. 23