home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug054.arc / ADDR.BAS < prev    next >
BASIC Source File  |  1979-12-31  |  23KB  |  379 lines
  1. 8 '
  2. ==================================
  3. === Written & Copyright (c) by ===
  4. ===        John Dowdall        ===
  5. 9 ' OK  TO COPY FOR INDIVIDUAL ===
  6. === USE ONLY.COMMERCIAL RIGHTS ===
  7. ===   RESERVED  BY  MICROFLEX  ===
  8. ==================================
  9. 10 CLEAR:WIDTH 255:WIDTH LPRINT 255
  10. 12 DEF FNC$(R,C)=CHR$(27)+"="+CHR$(32+R)+CHR$(32+C)
  11. 14 CLS$=CHR$(26):SX%=79:SY%=24:MT%=50:PU$="$$########.##"
  12. 16 GOSUB 1302:PRINT FNC$(12,0);:INPUT "ENTER DRIVE FOR DATA (ABCD) ";DN$:IF INSTR("ABCDabcd",DN$)=0 OR DN$="" THEN DN$="A:" ELSE DN$=DN$+":"
  13. 18 MID$(DN$,1,1)=CHR$(ASC(DN$) AND 95):IF INSTR("ABCD",LEFT$(DN$,1))=0 THEN 16
  14. 20 PRINT FNC$(12,30);DN$;:RL%=106:GOSUB 102:IF KP%<1 THEN GOTO 702
  15. 22 GOSUB 138:GOSUB 112:MK%=MR%+(MR%/2)
  16. 24 CHANGE$=CHR$(5):DELE$=CHR$(4)
  17. 26 BACK$=CHR$(1):FORWARD$=CHR$(7)
  18. 28 FIRST$=CHR$(6):LAST$=CHR$(24)
  19. 30 SKIPF$=CHR$(23):SKIPB$=CHR$(26)
  20. 32 REINDEX$=CHR$(18):SORT$=CHR$(20)
  21. 34 PRIN$=CHR$(16):CLEARW$=CHR$(11)
  22. 36 REM
  23. 38 ON ERROR GOTO 1702
  24. 40 GOTO 302
  25. 100 REM ------------------------DISK FILE HANDLING-------------------------
  26. 102 OPEN "R",1,DN$+"ADR.DAT",RL%
  27. 104 OPEN "R",2,DN$+"ADR.NDX",2:FIELD #2,2 AS KP$:GET 2,1:KP%=CVI(KP$)
  28. 106 OPEN "R",3,DN$+"CAT.NDX",2:FIELD #3,2 AS YT$:LSET YT$=MKI$(KP%):PUT 3,1
  29. 108 RETURN
  30. 110 RETURN
  31. 112 FIELD #1,30 AS F0$,25 AS F1$,20 AS F2$,6 AS F3$,12 AS F6$,8 AS F4$,5 AS F5$
  32. 114 RETURN
  33. 116 W0$=F0$:W1$=F1$:W2$=F2$:W3$=F3$:W4$=F4$:W5$=F5$:W6$=F6$
  34. 118 RETURN
  35. 120 LSET F0$=W0$:LSET F1$=W1$:LSET F2$=W2$:LSET F3$=W3$:LSET F4$=W4$:LSET F5$=W5$:LSET F6$=W6$
  36. 122 RETURN
  37. 124 REM
  38. 126 RETURN
  39. 128 GET 1,PR%
  40. 130 RETURN
  41. 132 PUT 1,PR%
  42. 134 RETURN
  43. 136 W0$="":W1$="":W2$="":W3$="":W4$="":W5$="":W6$=""
  44. 138 FIELD #1,20 AS F0$,30 AS F1$,3 AS LT$,3 AS LE$,2 AS LP$,2 AS PC$,2 AS PP$,2 AS PI$,2 AS MR$,2 AS DR$:GET 1,1:CN$=F0$:CA$=F1$:LS$=LT$:LD$=LE$:LP=CVI(LP$):PC%=CVI(PC$):PP%=CVI(PP$):PI%=CVI(PI$):MR%=CVI(MR$):DR%=CVI(DR$):RETURN
  45. 140 FIELD #1,20 AS F0$,30 AS F1$,3 AS LT$,3 AS LE$,2 AS LP$, 2 AS PC$,2 AS PP$,2 AS PI$,2 AS MR$,2 AS DR$: LSET F0$=CN$:LSET F1$=CA$:LSET LT$=LS$:LSET LE$=LD$: LSET LP$=MKI$(LP):LSET PC$=MKI$(PC%):LSET PP$=MKI$(PP%): LSET PI$=MKI$(PI%)
  46. 142  LSET MR$=MKI$(MR%):LSET DR$=MKI$(DR%): PUT 1,1:RETURN
  47. 144 FIELD #3,2 AS JP$:RETURN
  48. 146 RETURN
  49. 148 RETURN
  50. 150 RETURN
  51. 152 RETURN
  52. 154 FOR Z8=1 TO 900:NEXT Z8:RETURN
  53. 200 REM --------------------KEYBOARD ENTRY ROUTINE----------------------------
  54. 202 A$=INKEY$:A1$=""
  55. 204 A$=INKEY$:IF A$="" THEN 204 ELSE IF A$=CHR$(13) THEN RETURN
  56. 206 IF A$="@" THEN A1$=A$:RETURN ELSE IF A$=CHR$(127) THEN A$=CHR$(8)
  57. 208 IF ASC(A$)=ASC("L")-64 THEN A1$=A$:RETURN
  58. 210 IF A$=PRIN$ THEN 218
  59. 212 IF (A$<>CHR$(8) AND ASC(A$)<32) THEN A1$=A$:RETURN
  60. 214 IF LEN(A1$)>0 AND A$=CHR$(8) THEN A1$=LEFT$(A1$,LEN(A1$)-1):PRINT A$;:GOTO 204 ELSE IF LEN(A1$)=0 AND A$=CHR$(8) THEN 204
  61. 216 A1$=A1$+A$:PRINT A$;:A$="":GOTO 204
  62. 218 IF PRIN% THEN PRIN%=0:PRINT FNC$(1,0);SPC(2);:GOTO 222
  63. 220 IF NOT(PRIN%) THEN PRIN%=-1:PRINT FNC$(1,0);CHR$(27);CHR$(41);"^P";CHR$(27);CHR$(40);
  64. 222 PRINT FNC$(9,23);
  65. 224 '
  66. 226 GOTO 202
  67. 300 REM    ---------------------MAIN DATA-ENTRY SCREEN---------------------------
  68. 302 GOSUB 112:GOSUB 1302:GOSUB 1516:GOSUB 1502:GET 1,KP%:LSTWUN$=F0$
  69. 304 FR$="    ^A=BACK 1     ^G=FWD 1      ^Z=BACK 10    ^W=FWD 10       ^F=FIRST ":FS$="    ^X=LAST       ^E=EDIT       ^D=DELETE     ^K=CLEAR WNDW   ^R=REINDEX":FS1$="    ^T=SORT       ^L=LABELS     ^P=PRINT"
  70. 306 GOSUB 2002:IF TGT$="?" THEN GOSUB 1002:GOTO 302 ELSE IF TGT$="*" THEN 802 ELSE IF TGT$="@" THEN 306 ELSE IF ASC(TGT$)=ASC("L")-64 THEN 2102
  71. 308 IF (TGT$=CHANGE$ AND DISFLAG=1) THEN GOSUB 402:GOSUB 120:GOSUB 132:GOTO 306 ELSE IF (TGT$=DELE$ AND DISFLAG=1) THEN GOSUB 460:GOTO 302 ELSE IF TGT$=CLEARW$ THEN DISFLAG=0:GOTO 302
  72. 310 IF TGT$=REINDEX$ THEN GOSUB 1302:GOSUB 602:DISFLAG=0:GOTO 302 ELSE IF TGT$=SORT$ THEN GOSUB 502:DISFLAG=0:GOTO 302
  73. 312 IF (TGT$=BACK$ OR TGT$=SKIPB$ OR TGT$=FORWARD$ OR TGT$=SKIPF$) AND DISFLAG=1 THEN GOSUB 924:GOSUB 1602:TGT$=W0$:GOTO 306
  74. 314 IF (TGT$=FIRST$ OR TGT$=LAST$ OR TGT$="." OR (VAL(TGT$)>0 AND VAL(TGT$)<=KP%)) THEN GOSUB 924:GOSUB 1602:DISFLAG=1:TGT$=W0$:GOTO 306
  75. 316 IF BY=1 THEN W0$=F0$:GOSUB 1602:DISFLAG=1:GOTO 306 ELSE DISFLAG=0:W0$=TGT$
  76. 318 CF#=0#:TF#=0#:SF#=0#:PRINT FNC$(11,23);
  77. 320 GOSUB 202:W1$=A1$:IF LEFT$(W1$,1)=CLEARW$ THEN DISFLAG=0:GOTO 302
  78. 322 BY=255:PRINT FNC$(13,23);:GOSUB 202:W2$=A1$:IF W2$=CLEARW$ THEN DISFLAG=0:GOTO 302
  79. 324 PRINT FNC$(15,23);:GOSUB 202:W3$=A1$:IF W3$=CLEARW$ THEN DISFLAG=0:GOTO 302
  80. 326 PRINT FNC$(17,23);:GOSUB 202:W6$=A1$:IF W6$=CLEARW$ THEN DISFLAG=0:GOTO 302
  81. 328 PRINT FNC$(19,23);:GOSUB 202:W4$=LEFT$(A1$+"00000000",8):IF LEFT$(W4$,LEN(CLEARW$))=CLEARW$ THEN DISFLAG=0:GOTO 302 ELSE PRINT FNC$(19,23);W4$;
  82. 330 PR%=KP%+1:KP%=KP%+1:GOSUB 120:GOSUB 132:LSET KP$=MKI$(KP%):PUT 2,1:LSET KP$=MKI$(PR%):PUT 2,KQ%:GOSUB 938:LSTWUN$=W0$:LSTREC%=KP%
  83. 332 IF YN=1 THEN RETURN
  84. 334 GOTO 302
  85. 400 REM    --------------------------EDITING-------------------------------------
  86. 402 PRINT FNC$(11,5);"<1>";:PRINT FNC$(13,5);"<2>";:PRINT FNC$(15,5);"<3>";:PRINT FNC$(17,5);"<4>";FNC$(19,5);"<5>";
  87. 404 PRINT FNC$(22,0);CHR$(27)+"Y";:INPUT "WHICH TO EDIT (1-5 OR 0 TO QUIT) ";EV:IF EV=0 THEN 424
  88. 406 IF EV>6 THEN 404
  89. 408 PRINT FNC$(22,0);CHR$(27)+"T";
  90. 410 IF EV=6 THEN INPUT "   NEW NAME (max=30) ";W0$:LSET F0$=W0$:PRINT FNC$(9,23);F0$;:GOTO 404
  91. 412 IF EV=1 THEN INPUT "NEW ADDRESS (max=25) ";W1$:LSET F1$=W1$:PRINT FNC$(11,23);F1$;:GOTO 404
  92. 414 IF EV=2 THEN INPUT "   NEW CITY (max=20) ";W2$:LSET F2$=W2$:PRINT FNC$(13,23);F2$;:GOTO 404
  93. 416 IF EV=3 THEN INPUT " NEW P'CODE (MAX=6)  ";W3$:LSET F3$=W3$:PRINT FNC$(15,23);F3$;:GOTO 404
  94. 418 IF EV=4 THEN INPUT " NEW PHONE (MAX=12)  ";W6$:LSET F6$=W6$:PRINT FNC$(17,23);F6$;:GOTO 404
  95. 420 IF EV=5 THEN INPUT "NEW CATEGORY (MAX=8) ";W4$:LSET F4$=W4$+"00000000":PRINT FNC$(19,23);F4$;:GOTO 404
  96. 422 GOTO 404
  97. 424 GOSUB 1516:GOSUB 120:GOSUB 132:PRINT FNC$(11,5);"   ";FNC$(13,5);"   ";FNC$(15,5);"   ";FNC$(17,5);"   ";FNC$(19,5);"   ";:RETURN
  98. 450 REM    ---------------------------DELETE-------------------------------------
  99. 452 FR$="DELETE ENTRY":GOSUB 1302:GOSUB 138:GOSUB 112
  100. 454 GOSUB 902:IF TGT$="?" THEN GOSUB 1002:GOTO 454 ELSE IF TGT$="*" THEN 302
  101. 456 IF BY=0 OR BY=9 THEN 454 ELSE IF TGT$="*" THEN GOSUB 140:GOTO 302
  102. 458 IF LEFT$(W1$,3)="***" THEN PRINT "///PREVIOUSLY DELETED///":GOTO 464
  103. 460 MID$(W1$,1,3)="***":GOSUB 120:GOSUB 132
  104. 462 PRINT "///DELETED///"
  105. 464 FOR I=1 TO 300:NEXT I:RETURN
  106. 500 REM    ---------------------------SORT---------------------------------------
  107. 502 GOSUB 1302:PRINT "SORT FILE";:GOSUB 2600:GOSUB 138:FIELD #1,RL% AS F$:S1$=STRING$(RL%,32):S2$=S1$:S3$=S2$:PRINT FNC$(12,0);"SORTING FILE...PLEASE WAIT"
  108. 504 M=KP%-1:N=M
  109. 506 M=INT(M/2):PRINT M;
  110. 508 IF M=0 THEN 538
  111. 510 J=1:K=N-M
  112. 512 I=J
  113. 514 L=I+M
  114. 516 GET 1,I+1:MID$(S1$,1,RL%)=F$:GET 1,L+1:MID$(S2$,1,RL%)=F$
  115. 518 IF (MID$(S1$,31,3)="***" AND MID$(S2$,31,3)="***") THEN 532 ELSE IF MID$(S1$,31,3)="***" THEN 524 ELSE IF MID$(S2$,31,3)="***" THEN 532 ELSE 522
  116. 520 PRINT CHR$(7);:LSET F$=S1$:PUT 1,L+1:LSET F$=S2$:PUT 1,I+1:GOTO 526
  117. 522 IF MID$(S1$,SP,NK)+S1$<=MID$(S2$,SP,NK)+S2$ THEN 532
  118. 524 LSET F$=S1$:PUT 1,L+1:LSET F$=S2$:PUT 1,I+1
  119. 526 I=I-M
  120. 528 IF I<1 THEN 532
  121. 530 GOTO 514
  122. 532 J=J+1
  123. 534 IF J>K THEN 506
  124. 536 GOTO 512
  125. 538 I=KP%:GET 1,I:MID$(S1$,1,RL%)=F$
  126. 540 IF MID$(S1$,31,3)="***" THEN KP%=KP%-1:GOTO 538
  127. 542 LSET KP$=MKI$(KP%):PUT 2,1
  128. 544 LSET YT$=MKI$(KP%):PUT 3,1
  129. 546 PRINT STRING$(25,7);:GOTO 602
  130. 600 REM    ----------------------------REKEY INDEX-------------------------------
  131. 602 GOSUB 112
  132. 604 PRINT FNC$(23,0);"RE-INDEXING ";KP%-1;" KEY RECORDS ON   *** NAME ***"
  133. 606 LSET KP$=MKI$(-1):FOR PR%=1 TO MK%:PUT 2,PR%:NEXT PR%:LSET KP$=MKI$(KP%):PUT 2,1:PRINT CHR$(7);:FOR PR%=2 TO KP%:PRINT FNC$(22,75);PR%-1;
  134. 608 GOSUB 128:GOSUB 116:ZZ$=W0$
  135. 610 GOSUB 1102:IF RP>MK% OR RP<2 THEN RP=2
  136. 612 GET 2,RP
  137. 614 IF LEFT$(W1$,3)="***" THEN LSET KP$=MKI$(-PR%):PUT 2,RP:GOTO 620
  138. 616 IF CVI(KP$)>0 THEN RP=RP+1:GOTO 612
  139. 618 LSET KP$=MKI$(PR%):PUT 2,RP
  140. 620 NEXT PR%:GOTO 652
  141. 622 REM
  142. 624 RETURN
  143. 650 REM -----------REKEY CATEGORY INDEX----------
  144. 652 GOSUB 112
  145. 654 PRINT FNC$(23,0);"RE-INDEXING ";KP%-1;" KEY RECORDS ON   *** CATEGORY ***"
  146. 656 LSET YT$=MKI$(-1):FOR PR%=1 TO MK%:PUT 3,PR%:NEXT PR%:LSET YT$=MKI$(KP%):PUT 3,1:PRINT CHR$(7);:FOR PR%=2 TO KP%:PRINT FNC$(22,75);PR%-2;
  147. 658 GOSUB 128:GOSUB 116:YY$=W4$
  148. 660 GOSUB 1152:IF RY>MK% OR RY<2 THEN RY=2
  149. 662 GET 3,RY
  150. 664 IF LEFT$(W1$,3)="***" THEN LSET YT$=MKI$(-PR%):PUT 3,RY:GOTO 670
  151. 666 IF CVI(YT$)>0 THEN RY=RY+1:GOTO 662
  152. 668 LSET YT$=MKI$(PR%):PUT 3,RY
  153. 670 NEXT PR%:GOSUB 140:TOGGLE=0:PRINT CHR$(7);:GOTO 302
  154. 700 REM    ----------------------INITIALISE NEW FILE-----------------------------
  155. 702 GOSUB 1302:PRINT
  156. 704 YN$="Y":GOSUB 1220:GOSUB 112:PRINT "NEW FILE":PRINT STRING$(SY%/3,10);:INPUT "YOUR COMPANY NAME (MAX=20) ";CN$:IF CN$="*" THEN CLOSE:CLEAR:RUN
  157. 706 INPUT "ADDRESS AS 1 LINE (MAX=30) ";CA$
  158. 708 LS$="":LD$="":FOR I=1 TO 3:LS(I)=0:LD(I)=0:NEXT I:T=1
  159. 710 LS$=STRING$(3,0)
  160. 712 '
  161. 714 LD$=STRING$(3,0)
  162. 716 '
  163. 718 INPUT "PRT PAGE LENGTH IN LINES ";LP
  164. 720 INPUT "MAXIMUM NUMBER OF RECORDS (1000-20000) ";MR%:IF MR%<1000 OR MR%>20000 THEN 720 ELSE MK%=MR%+INT(MR%/2)
  165. 722 PI%=0:PP%=0:PC%=0
  166. 724 PR%=1:PRINT:INPUT "DETAILS OK (.Y/N) ";YN$:IF YN$="" THEN YN$="Y" ELSE YN$=CHR$(ASC(YN$) AND 95)
  167. 726 IF YN$<>"Y" THEN 702
  168. 728 FIELD #1,20 AS F0$,30 AS F1$,3 AS LT$,3 AS LE$,2 AS LP$,2 AS PI$,2 AS PC$,2 AS PP$,2 AS MR$,2 AS DR$:LSET F0$=CN$:LSET F1$=CA$:LSET LT$=LS$:LSET LE$=LD$:LSET LP$=MKI$(LP):LSET PI$=MKI$(PI%):LSET PC$=MKI$(PC%):LSET PP$=MKI$(PP%)
  169. 730 LSET MR$=MKI$(MR%):LSET DR$=MKI$(0):PUT 1,1
  170. 732 FIELD #2,2 AS KP$:LSET KP$=MKI$(-1)
  171. 734 FOR I=1 TO MK%:PUT 2,I:NEXT I:LSET KP$=MKI$(1):PUT 2,1
  172. 736 FIELD #3,2 AS YT$:LSET YT$=MKI$(-1)
  173. 738 FOR I=1 TO MK%:PUT 3,I:NEXT I:LSET YT$=MKI$(1):PUT 3,1
  174. 740 CLOSE:GOTO 20
  175. 798 REM =======================GENERAL SUB-ROUTINES===========================
  176. 800 REM -------------------------PROGRAM EXIT SCREEN--------------------------
  177. 802 GOSUB 1302:PRINT FNC$(12,0);;"THANK YOU FOR USING MICROFLEX  'ADDRESS FILE' ";FNC$(20,0);"WAIT FOR >OK BEFORE SWITCHING OFF":GOSUB 140:CLOSE:END
  178. 900 REM ------------------------KEYBOARD INPUT OF KEY-------------------------
  179. 902 GOSUB 1420
  180. 904 PRINT FNC$(9,23);:GOSUB 202:TGT$=A1$:IF TGT$="*" THEN RETURN ELSE IF TGT$="?" THEN RETURN ELSE IF TGT$="@" THEN TOGGLE=1:RETURN
  181. 906 IF (VAL(TGT$)>0 AND VAL(TGT$)<=KP%) THEN PR%=VAL(TGT$)+1:GOSUB 128:GOSUB 116:TGT$=W0$:P1=1:GOTO 918
  182. 908 IF (ASC(TGT$)<32 OR TGT$=".") THEN RETURN
  183. 910 ZZ$=LEFT$(TGT$+STRING$(30,32),30):GOSUB 1102:IF RP>MK% OR RP<2 THEN RP=2
  184. 912 KQ%=RP:GET 2,RP:PR%=CVI(KP$):IF KP%<2 THEN PR%=2:BY=0:RETURN ELSE IF PR%<0 THEN PR%=KP%+1:BY=0:PRINT FNC$(1,35);"NOT FOUND";:RETURN
  185. 914 P1=0:IF PR%<=KP% THEN GOSUB 128:GOSUB 116:P1=INSTR(W0$,TGT$) ELSE GOTO 920
  186. 916 IF P1=0 THEN RP=RP+1:GOTO 912 ELSE IF (LEFT$(W1$,3)="***" AND INSTR(W0$,TGT$)>0) THEN PRINT "///DELETED RECORD///":BY=0:RETURN
  187. 918 IF P1=1 THEN YN$="Y":BY=1:W0$=TGT$:RETURN
  188. 920 IF P1=0 THEN BY=9:GOSUB 154:RETURN
  189. 922 KQ%=RP:BY=1:RETURN
  190. 924 IF TGT$=BACK$ THEN PR%=PR%-1:GOTO 928 ELSE IF TGT$=FORWARD$ THEN PR%=PR%+1:GOTO 928 ELSE IF TGT$=SKIPB$ THEN PR%=PR%-10:GOTO 928 ELSE IF TGT$=SKIPF$ THEN PR%=PR%+10:GOTO 928
  191. 926 IF TGT$=FIRST$ THEN PR%=2 ELSE IF TGT$=LAST$ THEN PR%=KP% ELSE IF  TGT$="." THEN PR%=LSTREC%+1 ELSE IF VAL(TGT$)>0 AND VAL(TGT$)<=KP% THEN PR%=VAL(TGT$)
  192. 928 IF PR%>KP% THEN PR%=KP% ELSE IF PR%<2 THEN PR%=2
  193. 930 P1=0:IF PR%<=KP% THEN GOSUB 128:GOSUB 116:P1=0
  194. 932 IF P1>0 AND (TGT$=FORWARD$ OR TGT$=SKIPF$ OR TGT$=LAST$) THEN PR%=PR%+1:GOTO 928 ELSE IF P1>0 AND (TGT$=BACK$ OR TGT$=SKIPB$ OR TGT$=FIRST$) THEN PR%=PR%-1:GOTO 928
  195. 934 GOSUB 128:GOSUB 116
  196. 936 RETURN
  197. 938 YY$=W4$:GOSUB 1152
  198. 940 GET 3,RY:IF CVI(YT$)>0 THEN RY=RY+1:GOTO 940
  199. 942 LSET YT$=MKI$(PR%):PUT 3,RY
  200. 944 RETURN
  201. 1000 REM -------------------------PRINT '?' LISTING---------------------------
  202. 1002 I8%=-1:GOSUB 112:GOSUB 1302:PRINT:FOR I9%=2 TO KP%:GET 1,I9%:GOSUB 116
  203. 1004 IF LEFT$(W1$,3)<>"***" THEN I8%=I8%+1:PRINT TAB(40*I8%);I9%;W0$;W1$;
  204. 1006 IF I8%=1 THEN I8%=-1
  205. 1008 NEXT I9%:PRINT:PRINT:INPUT "PRESS <ENTER> TO CONTINUE ";YN$:RETURN
  206. 1100 REM -----------------------------HASHING ALGORITHM-----------------------
  207. 1102 FOR ZZ=1 TO LEN(ZZ$)
  208. 1104 SP=ASC(MID$(ZZ$,ZZ,1)):X#=X#+ZZ*(SP+1/SP)
  209. 1106 NEXT
  210. 1108 IF X#<1E+17 THEN X#=X#*X#:GOTO 1108
  211. 1110 SP=ASC(ZZ$)+ASC(RIGHT$(ZZ$,1)):SP=SP-10*(INT(SP/10)):SP=SP+4:X$=STR$(X#):RP=VAL(MID$(X$,SP,4)):X#=0
  212. 1112 RP=MK%*RP/9999!:RP=FIX(RP):RETURN
  213. 1150 REM -------------------CATEGORY HASH-----------------
  214. 1152 FOR YY=1 TO LEN(YY$)
  215. 1154 YP=ASC(MID$(YY$,YY,1)):YY#=YY#+YY*(YP+1/YP)
  216. 1156 NEXT
  217. 1158 IF YY#<1E+17 THEN YY#=YY#*YY#:GOTO 1158
  218. 1160 YP=ASC(YY$)+ASC(RIGHT$(YY$,1)):YP=YP-10*(INT(YP/10)):YP=YP+4:XX$=STR$(YY#):RY=VAL(MID$(XX$,YP,4)):YY#=0
  219. 1162 RY=MK%*RY/9999!:RY=FIX(RY):RETURN
  220. 1200 REM -------------------------DATE CHECKING & CONVERSION-------------------
  221. 1202 DSEP$=" !%'()*:-~^^+;`|\<>,.":FOR KK=1 TO LEN(D$):IF INSTR(DSEP$,MID$(D$,KK,1))>0 THEN MID$(D$,KK,1)="/":GOTO 1202
  222. 1204 NEXT KK:IF LEN(D$)=8 THEN 1210 ELSE IF LEN(D$)=7 OR LEN(D$)=6 THEN KX=4ELSE IF LEN(D$)<6 THEN 1218
  223. 1206 IF MID$(D$,2,1)="/" THEN D$="0"+D$
  224. 1208 IF MID$(D$,5,1)="/" THEN D$=LEFT$(D$,3)+"0"+RIGHT$(D$,KX)
  225. 1210 IF LEN(D$)<>8 THEN 1218 ELSE M=VAL(MID$(D$,4,2)):IF M<1 OR M>12 THEN 1218
  226. 1212 D1=VAL(LEFT$(D$,2)):IF D1<1 OR D1>31 THEN 1218ELSE Y=1900+VAL(RIGHT$(D$,2)):Y=Y/4:IF Y=INT(Y) THEN M2=29ELSE M2=28
  227. 1214 IF (M=2 AND D1>M2) THEN 1218 ELSE IF (M=4 OR M=6 OR M=9 OR M=11) AND (D>30) THEN 1218
  228. 1216 FL=0:RETURN
  229. 1218 FL=1:RETURN
  230. 1220 D0=VAL(MID$(D$,4,2))-1:D0=(D0*31)+VAL(LEFT$(D$,2))+VAL(RIGHT$(D$,2))*1000:DB$=MKS$(D0)
  231. 1222 RETURN
  232. 1224 D2=CVS(DB$):D3=INT(D2/1000):DA$=MID$(STR$(D3),2):DA$=RIGHT$("00"+DA$,2):DA$="/"+DA$:D4=D2-(D3*1000):D5=D4:D6=1
  233. 1226 IF D5>31 THEN D6=D6+1:D5=D5-31:GOTO 1226 ELSE T$=MID$(STR$(D6),2):T$=RIGHT$("00"+T$,2):DA$="/"+T$+DA$:T$=MID$(STR$(D5),2):T$=RIGHT$("00"+T$,2):DA$=T$+DA$
  234. 1228 RETURN
  235. 1300 REM --------------------------SCREEN HEADER-----------------------------
  236. 1302 PRINT CLS$:PRINT FNC$(2,0);STRING$(20,46);"M.U.G.W.A.  PUBLIC DOMAIN ADDRESS FILE";STRING$(21,46)
  237. 1304 PRINT STRING$(SX%,46);:IF PRIN% THEN PRINT FNC$(1,0);CHR$(27);CHR$(41);"^P";CHR$(27);CHR$(40); ELSE PRINT FNC$(1,0);SPC(2);
  238. 1306 PRINT FNC$(4,0);:RETURN
  239. 1400 REM -----------------------PRESS <RETURN> PROMPTS----------------------
  240. 1402 INPUT "1=print LABELS     2=print ADDRESS BOOK     3=QUIT (.1/2/3) ";LB$:IF LB$="" THEN LB$="1" ELSE IF INSTR("123",LB$)=0 THEN LB$="3"
  241. 1404 IF LB$="1" THEN INPUT "<C>ount or <P>rint  (C/.P) ";CP$:IF CP$="" THEN CP$="P" ELSE CP$=CHR$(ASC(CP$) AND 95)
  242. 1406 RETURN
  243. 1408 INPUT "Set printer to top of form, then press <RETURN>...";YN$
  244. 1410 RETURN
  245. 1412 INPUT "Set printer to top of new label, then press <RETURN>...";YN$
  246. 1414 RETURN
  247. 1416 INPUT "Press <RETURN> to continue...";YN$
  248. 1418 RETURN
  249. 1420 BY=0:PRINT FNC$(4,0);FR$;FNC$(5,0);FS$;FNC$(6,0);FS1$;FNC$(6,46);CHR$(27)+CHR$(41);LSTWUN$;CHR$(27)+CHR$(40);FNC$(4,74);KP%-1;
  250. 1422 PRINT FNC$(23,0);SPC(79);FNC$(23,23);"TO EXIT TYPE '*' INSTEAD OF KEY FIELD";:R=10:C=23
  251. 1424 RETURN
  252. 1500 REM -------------------DATA ENTRY WINDOWS-------------------------------
  253. 1502 PRINT FNC$(9,0);LSTREC%;FNC$(9,17);"NAME <______________________________>";SPC(15);
  254. 1504 PRINT FNC$(11,14);"ADDRESS  _________________________";SPC(15);
  255. 1506 PRINT FNC$(13,17);"CITY  ____________________";SPC(15);
  256. 1508 PRINT FNC$(15,13);"POSTCODE  ______";SPC(15);
  257. 1510 PRINT FNC$(17,16);"PHONE  ____________";SPC(15);
  258. 1512 PRINT FNC$(19,13);"CATEGORY <________>";SPC(15);
  259. 1514 RETURN
  260. 1516 PRINT FNC$(21,0);STRING$(80,46);:PRINT STRING$(80,46);
  261. 1518 RETURN
  262. 1600 REM -------------------FILL WINDOWS AFTER 'FIND'-------------------------
  263. 1602 GOSUB 1502:PRINT FNC$(9,0);LSTREC%;FNC$(9,5);PR%-1;FNC$(9,23);F0$;FNC$(11,23);F1$;FNC$(13,23);F2$;FNC$(15,23);F3$;FNC$(17,23);F6$;FNC$(19,23);F4$;
  264. 1604 LSTREC%=PR%-1:IF PRIN% THEN GOSUB 2800
  265. 1606 RETURN
  266. 1700 REM -----------------------------ERROR TRAP------------------------------
  267. 1702 PRINT "ERROR";ERR;"IN LINE ";ERL
  268. 1704 RESUME 1706
  269. 1706 CLOSE:END
  270. 1800 REM -------------------------get record by category----------------------
  271. 1802 GOSUB 1420
  272. 1804 PRINT FNC$(19,23);:GOSUB 202:TGT$=A1$:IF TGT$="*" THEN RETURN ELSE IF TGT$="?" THEN RETURN ELSE IF TGT$="@" THEN TOGGLE=0:RETURN ELSE IF TGT$=PRIN$ THEN TOGGLE=0:RETURN
  273. 1806 IF TGT$=REINDEX$ THEN RETURN
  274. 1808 IF (TGT$=CHANGE$ OR TGT$=DELE$ OR TGT$=CLEARW$ OR TGT$=SORT$) THEN TOGGLE=0:RETURN
  275. 1810 IF (TGT$=BACK$ OR TGT$=FORWARD$ OR TGT$=FIRST$ OR TGT$=LAST$) THEN TOGGLE=0:RETURN
  276. 1812 IF (TGT$=SKIPB$ OR TGT$=SKIPF$) THEN TOGGLE=0:RETURN
  277. 1814 YY$=LEFT$(TGT$+STRING$(8,"0"),8):GOSUB 1152:IF RY>MK% OR RY<2 THEN RY=2
  278. 1816 KQ%=RY:GET 3,RY:PR%=CVI(YT$):IF KP%<2 THEN PR%=2:BY=0:RETURN ELSE IF PR%<0 THEN PR%=KP%+1:BY=0:PRINT FNC$(1,35);"NOT FOUND";:DISFLAG=0:TOGGLE=0:RETURN
  279. 1818 P1=0:IF PR%<=KP% THEN GOSUB 128:GOSUB 116:P1=INSTR(W4$,TGT$) ELSE 1824
  280. 1820 IF P1=0 THEN RY=RY+1:GOTO 1816 ELSE IF (LEFT$(W1$,3)="***" AND INSTR(W4$,TGT$)>0) THEN PRINT "///DELETED RECORD///":BY=0:RETURN
  281. 1822 IF P1=1 THEN GOSUB 1902:IF YN$="Y" THEN DISFLAG=0:BY=1:TOGGLE=0:RETURN ELSE RY=RY+1:GOTO 1816
  282. 1824 IF P1=0 THEN BY=9:GOSUB 154:TOGGLE=0:RETURN
  283. 1826 KQ%=RY:BY=1:TOGGLE=0:RETURN
  284. 1900 REM ---------------------------IS THIS THE ONE ??-----------------------
  285. 1902 R=23:C=33:GOSUB 1602:PRINT FNC$(23,0);"Is this the one requested (.Y/N) ";:GOSUB 202:YN$=A1$:IF YN$="" OR YN$=CHR$(13) THEN YN$="Y" ELSE YN$=CHR$(ASC(YN$) AND 95)
  286. 1904 PRINT FNC$(23,0);CHR$(27)+"Y";
  287. 1906 RETURN
  288. 2000 REM ---------------------------ADJUST TOGGLE FOR KEY FIELD--------------
  289. 2002 IF TOGGLE=0 THEN 902 ELSE IF TOGGLE=1 THEN 1802 ELSE TOGGLE=0:GOTO 902
  290. 2004 IF BY=99 THEN 302
  291. 2100 REM ........................PRINT LABELS..................................
  292. 2102 LB$="":CP$="":GOSUB 1302:PRINT FNC$(12,0);:GOSUB 1402:IF (LB$="1" AND CP$="C") THEN 2152 ELSE IF LB$="1" THEN GOSUB 1412 ELSE IF LB$="2" THEN GOSUB 1408 ELSE GOTO 302
  293. 2104 IF LB$="2" THEN GOTO 2200 ELSE IF LB$="3" THEN 302
  294. 2106 GOSUB 2502:PRINT FNC$(0,35);CHR$(27)+CHR$(41);CAT$;CHR$(27)+CHR$(40);
  295. 2108 FOR PR%=2 TO KP%
  296. 2110 GOSUB 128:GOSUB 116:IF LEFT$(W1$,3)="***" THEN 2116
  297. 2112 GOSUB 2402:PRINT FNC$(1,35);DX$;:IF NOT(CAT%) THEN 2116
  298. 2114 GOSUB 2802
  299. 2116 NEXT PR%
  300. 2118 GOTO 302
  301. 2150 REM ----------------------COUNT FOR CATEGORY SELECTED------------------
  302. 2152 CATCOUNT%=0:GOSUB 2502:PRINT FNC$(0,32);CHR$(27)+CHR$(41);"COUNT :";CAT$;CHR$(27)+CHR$(40);
  303. 2154 FOR PR%=2 TO KP%
  304. 2156 GOSUB 128:IF LEFT$(F1$,3)="***" THEN 2162
  305. 2158 GOSUB 2402:PRINT FNC$(1,39);DX$;:IF NOT(CAT%) THEN 2162
  306. 2160 CATCOUNT%=CATCOUNT%+1
  307. 2162 NEXT PR%
  308. 2164 PRINT:PRINT FNC$(16,0);"QUANTITY IN CATEGORY '";CHR$(27)+CHR$(41);CAT$;CHR$(27)+CHR$(40);"' IS";CATCOUNT%
  309. 2166 PRINT:GOSUB 1416
  310. 2168 GOTO 302
  311. 2200 REM .......................PRINT 'BOOK'...................................
  312. 2202 FOR PR%=2 TO KP% STEP 20:IF PR%>2 THEN LPRINT CHR$(12)
  313. 2204 LPRINT STRING$(79,46):LPRINT TAB(35);"ADDRESS BOOK":LPRINT STRING$(79,46):LPRINT " "
  314. 2206 FOR K=PR% TO PR%+9:I=K:IF I>KP% THEN 2224
  315. 2208 GET 1,K:GOSUB 116:IF (K+10)<=KP% THEN GET 1,(K+10)
  316. 2210 LPRINT TAB(5);W0$;:IF (K+10)<=KP% THEN LPRINT TAB(45);F0$ ELSE LPRINT " "
  317. 2212 LPRINT TAB(5);W1$;:IF (K+10)<=KP% THEN LPRINT TAB(45);F1$ ELSE LPRINT " "
  318. 2214 LPRINT TAB(5);W2$;:IF (K+10)<=KP% THEN LPRINT TAB(45);F2$ ELSE LPRINT " "
  319. 2216 LPRINT TAB(5);W3$,:ST=VAL(W3$):GOSUB 2302:LPRINT ST$;
  320. 2218 IF (K+10)<=KP% THEN LPRINT TAB(45);F3$,:ST=VAL(F3$):GOSUB 2302:LPRINT ST$ ELSE  LPRINT " "
  321. 2220 LPRINT TAB(5);W6$;:IF (K+10)<=KP% THEN LPRINT TAB(45);F6$ ELSE LPRINT " "
  322. 2222 LPRINT " "
  323. 2224 NEXT K:NEXT PR%
  324. 2226 LPRINT CHR$(12):GOTO 302
  325. 2300 REM .................DETERMINE STATE FROM POSTCODE........................
  326. 2302 IF (ST>=2000 AND ST<=2599) OR (ST>=2621 AND ST<=2899) THEN ST$="NSW":RETURN
  327. 2304 IF (ST>=2600 AND ST<=2620) OR (ST>=2900 AND ST<=2949) THEN ST$="ACT":RETURN
  328. 2306 IF (ST>=3000 AND ST<=3999) THEN ST$="VIC":RETURN
  329. 2308 IF (ST>=4000 AND ST<=4899) THEN ST$="QLD":RETURN
  330. 2310 IF (ST>=5000 AND ST<=5749) THEN ST$="SA ":RETURN
  331. 2312 IF (ST>=5750 AND ST<=5799) THEN ST$="NT ":RETURN
  332. 2314 IF (ST>=6000 AND ST<=6799) THEN ST$="WA ":RETURN
  333. 2316 IF (ST>=7000 AND ST<=7499) THEN ST$="TAS":RETURN
  334. 2318 ST$=" ":RETURN
  335. 2400 REM ....................CHECK CATEGORY FOR MATCH..........................
  336. 2402 DX$=F4$:IF CAT$="~~~~~~~~" THEN CAT%=-1:RETURN ELSE IF CAT$=DX$ THEN CAT%=-1:RETURN
  337. 2404 FOR I=1 TO 8
  338. 2406 IF MID$(CAT$,I,1)="~" THEN MID$(DX$,I,1)="~":GOTO 2412
  339. 2408 IF I<6 THEN CT%=VAL(MID$(DX$,I,1)):CU%=VAL(MID$(CAT$,I,1)):GOSUB 2702:IF CT%=CU% THEN MID$(DX$,I,1)=MID$(CAT$,I,1)
  340. 2410 IF I=6 THEN I=7:CT%=VAL(MID$(DX$,6,2)):CU%=VAL(MID$(CAT$,6,2)):GOSUB 2702:IF CT%=CU% THEN MID$(DX$,6,2)=MID$(CAT$,6,2)
  341. 2412 NEXT I
  342. 2414 IF CAT$=DX$ THEN CAT%=-1 ELSE CAT%=0
  343. 2416 RETURN
  344. 2500 REM ....................GET CATEGORY FOR LABELS...........................
  345. 2502 INPUT "Enter category required (use ~ for don't care) ";CAT$:IF CAT$="" THEN CAT$="~~~~~~~~" ELSE CAT$=LEFT$(CAT$+"~~~~~~~~",8)
  346. 2504 IF CAT$="~~~~~~~~" THEN 2512
  347. 2506 FOR I=1 TO LEN(CAT$):C$=MID$(CAT$,I,1)
  348. 2508 IF INSTR("0123456789~",C$)=0 THEN I=LEN(CAT$):CAT%=999 ELSE CAT%=0
  349. 2510 NEXT I:IF CAT%=999 THEN 2502
  350. 2512 RETURN
  351. 2600 REM ..........................GET SORT FIELD..............................
  352. 2602 PRINT FNC$(8,0);"1 = NAME       2 = ADDRESS";FNC$(9,0);"3 = CITY       4 = POSTCODE";FNC$(10,0);"5 = CATEGORY   * = QUIT         ";:INPUT SC$
  353. 2604 IF INSTR("12345*",SC$)=0 THEN 2602
  354. 2606 IF SC$="1" THEN SP=1:NK=30 ELSE IF SC$="2" THEN SP=31:NK=25 ELSE IF SC$="3" THEN SP=56:NK=20 ELSE IF SC$="4"  THEN SP=76:NK=6 ELSE IF SC$="5" THEN SP=94:NK=8 ELSE IF SC$="*" THEN 302
  355. 2608 RETURN
  356. 2700 REM ......................PART OF CATEGORY CHECK..........................
  357. 2702 IF (CT%/2)<>INT(CT%/2) THEN CT%=CT%-1:KJ(1)=1 ELSE KJ(1)=0
  358. 2704 IF (CT%-32)>=0 THEN CT%=CT%-32:KJ(6)=32 ELSE KJ(6)=0
  359. 2706 IF (CT%-16)>=0 THEN CT%=CT%-16:KJ(5)=16 ELSE KJ(5)=0
  360. 2708 IF (CT%-8)>=0 THEN CT%=CT%-8:KJ(4)=8 ELSE KJ(4)=0
  361. 2710 IF (CT%-4)>=0 THEN CT%=CT%-4:KJ(3)=4 ELSE KJ(3)=0
  362. 2712 IF (CT%-2)>=0 THEN CT%=CT%-2:KJ(2)=2 ELSE KJ(2)=0
  363. 2714 IF (CU%/2)<>INT(CU%/2) THEN CU%=CU%-1:KK(1)=1 ELSE KK(1)=0
  364. 2716 IF (CU%-32)>=0 THEN CU%=CU%-32:KK(6)=32 ELSE KK(6)=0
  365. 2718 IF (CU%-16)>=0 THEN CU%=CU%-16:KK(5)=16 ELSE KK(5)=0
  366. 2720 IF (CU%-8)>=0 THEN CU%=CU%-8:KK(4)=8 ELSE KK(4)=0
  367. 2722 IF (CU%-4)>=0 THEN CU%=CU%-4:KK(3)=4 ELSE KK(3)=0
  368. 2724 IF (CU%-2)>=0 THEN CU%=CU%-2:KK(2)=2 ELSE KK(2)=0
  369. 2726 KJ=0:CT%=-99:CU%=99
  370. 2728 KJ=KJ+1:IF ((KJ(KJ)+KK(KJ))>0 AND (KJ(KJ)=KK(KJ))) THEN CU%=CT%
  371. 2730 IF KJ<6 THEN 2728
  372. 2732 RETURN
  373. 2800 REM ........................PRINT COPY OF WINDOW..........................
  374. 2802 LPRINT W0$:LPRINT W1$:LPRINT W2$:LPRINT W3$,:ST=VAL(W3$)
  375. 2804 GOSUB 2300:LPRINT ST$
  376. 2806 LPRINT " ":LPRINT " "
  377. 2808 RETURN
  378. LPRINT W0$:LPRINT W1$:LPRINT W2$:LPRINT W3$,:ST=VAL(W3$)
  379. 2804 GO