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