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 / HAMRADIO / LIST-LOG.LBR / HAMLOG.BQS / HAмлOG.BAS
BASIC Source File  |  2000-06-30  |  12KB  |  375 lines
  1. 10 '**VARIABLES**
  2. 20 '
  3. 30 'B$,D$,E$,F$,N$,W$,Y$
  4. 40 'NN$,TH$,TM$,DA$,XO$,YR$
  5. 45 'FLX$,FXL$ 
  6. 50 'TH,TM,DA,XO,YR,C,D,M,S
  7. 55 'FLN$ = FILENAME 
  8. 60 'YN$ = TEMP STRING, USE ANYTIME
  9. 70 'NN$ = INPUT 
  10. 80 'DT$ = DATE STRING (YY/MM/DD)
  11. 90 'LXT = LENGTH OF EXTENSION
  12. 100 'FTL$= FILE TO LOAD
  13. 110 '
  14. 120 '********************DEFINES********************
  15. 130 O$="WB6CGW" 'OPERATOR - PUT YOUR CALL HERE
  16. 140 BS$="7100"   'BAND     - PUT YOUR BAND HERE
  17. 150 S$=" ,"     'SPACE+,
  18. 155 P$=STRING$(14,42) '*$
  19. 157 WT$=" WAIT"
  20. 158 CG$="COLLECT GARBAGE"
  21. 160 C=1           'Contact NUMBER
  22. 170 DEFSTR M 
  23. 175 LMX=600
  24. 180 EXT$="000"
  25. 190 I=1         'CONTACT #
  26. 200 JG= -1      'FOR JG COMMUNICATIONS CLOCK
  27. 210 DP= -1     'DUPLICATE
  28. 220 CLS$=CHR$(26)'clear screen char
  29. 230 BKS$=CHR$(8) 'backspace char
  30. 235 BEL$=CHR$(7) 'console bell
  31. 240 CO=0
  32. 245 Y$="0" 'time string
  33. 1000 '*****START PROGRAM*****
  34. 1100 PRINT CLS$
  35. 1200 PRINT TAB(5) "AMATEUR RADIO LOGGING PROGRAM"
  36. 1400 PRINT
  37. 1500 PRINT TAB(11) "MARCH 1986 WB6CGW" 
  38. 1600 GOSUB 36000
  39. 1900 GOSUB 36000:PRINT "ENTER DATE: (YY/MM/DD) ";
  40. 2000 INPUT DT$
  41. 2100 IF DT$="" THEN GOTO 2400
  42. 2150 DT$=" "+DT$
  43. 2300 GOTO 2650
  44. 2400 PRINT WT$:GOSUB 20300
  45. 2500 IF Y$="0" THEN GOSUB 36000:PRINT "CLOCK NOT INSTALLED":GOTO 1900
  46. 2600 DT$=DTE$
  47. 2650 GOSUB 19700
  48. 2652 CO=0
  49. 2655 GOSUB 9910
  50. 2660 PRINT:PRINT "DATE:";DT$
  51. 2665 PRINT:PRINT:PRINT "OK ? ";
  52. 2670 GOSUB 28000
  53. 2680 IF YN=(-1) THEN C=C-1:CO=CO-1: GOSUB 9500
  54. 2690 PRINT CLS$
  55. 2700 GOSUB 36000
  56. 2750 FLN$="LG"+MID$(DT$,2,2)+MID$(DT$,5,2)+MID$(DT$,8)+"."+EXT$
  57. 2800 PRINT O$" ON "BS$" - (enter '?' FOR HELP)"
  58. 2900 GOSUB 20300
  59. 3000 IF Y$="0" GOTO 3200
  60. 3100 PRINT:PRINT "TIME: "Y$
  61. 3200 PRINT:PRINT "LOG ENTRY #"C"     ENTER <CR> FOR MENU" 
  62. 3202 PRINT "CONTACT   #"C-CO"     "FRE(0)" BYTES FREE"
  63. 3210 IF FRE(0) < 1000 THEN GOSUB 37000
  64. 3300 PRINT:INPUT; "CALL: ";N$
  65. 3400 IF N$="M" OR N$="m" OR N$="" THEN GOTO 7400
  66. 3500 IF N$= "C" OR N$= "c" THEN GOSUB 22700:GOTO 2700
  67. 3600 IF N$= "D" OR N$= "d" THEN GOSUB 22800:GOTO 2700
  68. 3700 IF N$="?" OR N$="'?'" THEN GOSUB 23000:GOTO 2700
  69. 3800 IF DP=1 GOTO 4500
  70. 3900 FOR I = 1 TO C
  71. 4000 IF N$ = M(I,1) THEN GOTO 4300
  72. 4100 NEXT I
  73. 4200 GOTO 4500
  74. 4300 GOSUB 36000:PRINT P$;" DUPLICATE #"I;P$
  75. 4400 GOTO 3200
  76. 4500 PRINT "   RST: ? ";
  77. 4600 FOR N=1 TO 3
  78. 4700 YN$=INPUT$(1)
  79. 4800 PRINT YN$;
  80. 4900 W$(N)=YN$
  81. 5000 IF YN$=BKS$ THEN N=N-2
  82. 5100 IF N<1 THEN PRINT: GOTO 4500
  83. 5200 NEXT
  84. 5300 W$=W$(1)+W$(2)+W$(3)
  85. 5400 PRINT "   TIME: ";
  86. 5500 GOSUB 20300
  87. 5600 IF Y$="0" THEN GOTO 5700 ELSE GOTO 6600
  88. 5700 FOR N=1 TO 4
  89. 5800 YN$=INPUT$(1)
  90. 5900 PRINT YN$;
  91. 6000 Y$(N)=YN$
  92. 6100 IF YN$=BKS$ THEN N=N-2
  93. 6200 IF N<1 THEN PRINT: GOTO 5400
  94. 6300 NEXT
  95. 6400 Y$=Y$(1)+Y$(2)+Y$(3)+Y$(4)
  96. 6500 GOTO 6605
  97. 6600 PRINT Y$
  98. 6605 PRINT:PRINT
  99. 6610 LINE INPUT "COMMENT:";CT$
  100. 6700 GOSUB 36000:PRINT "ENTRY #"C" OK   ";
  101. 6710 GOSUB 28000
  102. 6800 IF YN=(-1) GOTO 3200 
  103. 6900 PRINT:PRINT
  104. 7000 M(C,1)=N$
  105. 7100 M(C,2)=W$+S$+Y$+S$+CT$
  106. 7200 C=C+1
  107. 7300 GOTO 7500
  108. 7400 GOSUB 7700
  109. 7500 GOTO 2900
  110. 7600 '*****MAIN MENU********************************
  111. 7700 GOSUB 36000:PRINT (C-1)-CO "CONTACTS -"C-1"ENTRIES IN LOG -"FRE(0)"BYTES FREE-"
  112. 7710 ON ERROR GOTO 19270
  113. 7720 IF FRE(0) < 1000 THEN GOSUB 36000:GOSUB 37000
  114. 7750 PRINT:PRINT:PRINT TAB(3) "-MENU:"
  115. 7800 PRINT
  116. 7900 PRINT TAB(5) "1 - CREATE LOG      6 - CHANGE OPERATOR/BAND"
  117. 8000 PRINT TAB(5) "2 - VIEW   LOG      7 - ERASE LOG"
  118. 8100 PRINT TAB(5) "3 - EDIT   LOG      8 - READ LOG FROM DISK"
  119. 8200 PRINT TAB(5) "4 - SEARCH CALL     9 - WRITE LOG TO DISK"
  120. 8300 PRINT TAB(5) "5 - CHANGE DISKS    0 - EXIT TO BASIC"
  121. 8400 PRINT SPC(24)"G - "CG$
  122. 8410 PRINT "CHOICE: ? ";
  123. 8500 A$=INPUT$(1)
  124. 8600 PRINT A$
  125. 8650 IF A$=CHR$(&H30) THEN GOSUB 20100
  126. 8660 IF A$="G" OR A$="g" THEN GOSUB 37000
  127. 8700 A=VAL(A$)
  128. 8800 ON A GOSUB 9100,10500,12000,30000,35000,9500,19300,17300,15100
  129. 8850 IF A=99 GOTO 7700
  130. 8900 IF A > 9 OR A < 1 THEN GOTO 9200
  131. 9000 IF A <> 1 GOTO 7700
  132. 9100 RETURN
  133. 9200 PRINT " ENTER 1 - 9"
  134. 9300 GOTO 8500
  135. 9400 '*****CHANGE CONTROL OPERATOR*****
  136. 9500 PRINT CLS$:PRINT:INPUT "WHAT IS YOUR CALL AS CONTROL OP";YN$
  137. 9600 IF YN$="" THEN O$=O$ ELSE O$=YN$
  138. 9700 GOSUB 36000:PRINT O$ " LOGGED ON"
  139. 9800 PRINT:PRINT: INPUT "ENTER BAND";YN$
  140. 9900 IF YN$="" THEN BS$=BS$ ELSE BS$=YN$
  141. 9910 IF Y$="0" THEN INPUT "ENTER TIME";Y$
  142. 10000 PRINT:PRINT "operator "O$" logged on "BS$" Khz at "Y$
  143. 10100 M(C,1)="-"+DT$+"  "+Y$+" -":M(C,2)="-  "+O$+S$+"ON "+BS$+" Khz -"
  144. 10200 C=C+1
  145. 10250 CO=CO+1
  146. 10260 GOSUB 20300
  147. 10300 RETURN
  148. 10400 '***** VIEW LOG *****
  149. 10500 PRINT CLS$:INPUT "STARTING AT WHAT CONTACT #";K
  150. 10600 IF K<1 OR K> LMX THEN K=1
  151. 10800 PRINT CLS$
  152. 11060 PRINT:PRINT
  153. 11100 FOR I=K TO K+19
  154. 11300 IF I < 10 THEN  PRINT "  ";I;
  155. 11400 IF I > 9 AND I < 100 THEN PRINT " ";I;
  156. 11500 IF I > 99 THEN PRINT I;
  157. 11600 PRINT TAB(7);M(I,1);TAB(26);M(I,2)
  158. 11700 NEXT I
  159. 11750 PRINT "MORE ?   <CR> CONTINUES  ";
  160. 11760 GOSUB 28000
  161. 11770 IF YN=1 OR YN=0 THEN K=K+20:PRINT:GOTO 11100
  162. 11800 RETURN
  163. 11900 '***** EDIT LOG **************
  164. 12000 PRINT CLS$:PRINT "EDIT LOG"
  165. 12100 INPUT "CHANGE LOG ENTRY #";L
  166. 12110 IF L<1 OR L> LMX THEN L=1
  167. 12115 GOSUB 36000:PRINT "EDIT ENTRY #"L
  168. 12200 PRINT:PRINT M(L,1)
  169. 12210 PRINT M(L,2)
  170. 12215 IF M(L,1)="" THEN PRINT:PRINT:PRINT "ENTRY #"L"BLANK":GOTO 14900
  171. 12300 PRINT
  172. 12310 PRINT:PRINT "RE-ENTER ITEM or  <CR> no change or  * TO DELETE"
  173. 12400 PRINT:PRINT "  "; M(L,1)
  174. 12402 INPUT N$
  175. 12410 IF N$=CHR$(42) THEN N$="*"+M(L,1):NN$=M(L,2):PRINT:PRINT:PRINT "DELETED":GOTO 14000
  176. 12500 IF N$="" THEN N$=M(L,1)
  177. 12600 GOSUB 36000
  178. 12610 IF LEFT$(N$,1)="-" THEN GOTO 13900
  179. 12700 PRINT "  ";LEFT$(M(L,2),3)
  180. 12710 INPUT W$
  181. 12800 IF W$="" THEN W$=LEFT$(M(L,2),3)
  182. 12900 PRINT
  183. 13000 PRINT "  ";MID$(M(L,2),6,4)
  184. 13010 INPUT Y$
  185. 13100 IF Y$="" THEN Y$=MID$(M(L,2),6,4)
  186. 13200 PRINT
  187. 13300 PRINT "  "; MID$(M(L,2),12)
  188. 13310 INPUT B$
  189. 13400 IF B$="" THEN B$=MID$(M(L,2),12)
  190. 13410 NN$=W$+S$+Y$+S$+B$
  191. 13500 GOTO 14000
  192. 13900 PRINT:PRINT M(L,2)
  193. 13910 LINE INPUT NN$
  194. 13920 IF NN$="" THEN NN$=M(L,2)
  195. 14000 PRINT:PRINT:PRINT N$
  196. 14010 PRINT NN$
  197. 14100 PRINT:PRINT
  198. 14200 PRINT "ENTRY #"L" OK ?  <CR> ACCEPT AND CONTINUE";
  199. 14210 GOSUB 28000
  200. 14300 IF YN=1 OR YN=0 GOTO 14700
  201. 14400 IF YN=(-1) THEN GOSUB 36000:GOTO 12115
  202. 14410 PRINT:PRINT "ENTER Y/N";
  203. 14420 GOTO 14210
  204. 14700 M(L,1)=N$
  205. 14800 M(L,2)=NN$
  206. 14810 IF YN=0 THEN L=L+1:PRINT:GOTO 12115 
  207. 14900 RETURN
  208. 15000 '***** SAVE LOG ROUTINE *****
  209. 15100 ON ERROR GOTO 19000
  210. 15102 GOSUB 36000:PRINT "SAVE WITH DATE ";DT$;:GOSUB 28000
  211. 15104 IF YN=0 THEN GOTO 17100
  212. 15106 IF YN=-1 THEN GOTO 15110
  213. 15108 IF YN=1 THEN GOTO 15200 
  214. 15109 GOTO 17100
  215. 15110 GOSUB 36000:PRINT "ENTER FILENAME TO SAVE:"
  216. 15120 INPUT " <CR> RETURNS TO MENU";FXN$
  217. 15130 IF FXN$="" THEN GOTO 17100
  218. 15185 ON ERROR GOTO 19260 
  219. 15186 KILL FXN$+".BAK"
  220. 15187 NAME FXN$ AS FXN$+".BAK" 
  221. 15188 ON ERROR GOTO 19100
  222. 15190 FLX$=FXN$
  223. 15195 GOTO 16410
  224. 15200 NAME FLN$ AS FLN$
  225. 15300 EXT$=MID$(FLN$,10)
  226. 15400 FLN$=LEFT$(FLN$,9)
  227. 15500 EXT=VAL(EXT$)
  228. 15600 EXT=EXT+1
  229. 15700 EXT$=STR$(EXT)
  230. 15800 EXT$=MID$(EXT$,2)
  231. 15900 LXT=LEN(EXT$)
  232. 16000 FOR YN=1 TO 3-LXT
  233. 16100 EXT$="0"+EXT$:NEXT
  234. 16200 FLN$=FLN$+EXT$
  235. 16300 GOTO 15200
  236. 16400 FLX$=FLN$
  237. 16410 GOSUB 36000:PRINT FLX$
  238. 16500 OPEN "O",#1,FLX$
  239. 16600 FOR I=1 TO ( C - 1 )
  240. 16650 IF LEFT$(M(I,1),1)=CHR$(42) GOTO 16800
  241. 16700 PRINT #1,M(I,1);" ,";CHR$(34);M(I,2);CHR$(34)
  242. 16800 NEXT I
  243. 16900 CLOSE#1
  244. 17000 PRINT "DATA SENT TO DISK"
  245. 17100 RETURN
  246. 17200 '***** LOAD FILE ROUTINE ********************** 
  247. 17300 GOSUB 36000:PRINT  "ENTER NAME OF FILE TO LOAD:"
  248. 17310 INPUT "    <CR> RETURNS TO MENU ";FTL$
  249. 17400 IF FTL$="" THEN GOTO 18600
  250. 17500 PRINT FTL$ " LOADING"
  251. 17600 ON ERROR GOTO 18800
  252. 17700 OPEN "I",#1,FTL$
  253. 17800 I=C
  254. 17900 INPUT #1,M(I,1),M(I,2)
  255. 17910 IF LEFT$(M(I,1),1)="-" THEN CO=CO+1
  256. 18000 I=I+1
  257. 18100 IF M(I,1)= "0" AND M(I,2)= "0" THEN 18400
  258. 18200 IF EOF(1) THEN 18400
  259. 18300 GOTO 17900
  260. 18400 CLOSE
  261. 18500 C=I
  262. 18600 RETURN
  263. 18700 '***** OPEN FILE ERROR ROUTINES *****
  264. 18800 GOSUB 36000:PRINT "ERROR # " ERR
  265. 18810 IF ERR=53 THEN PRINT "FILE NOT ON DISK":CLOSE
  266. 18820 IF ERR=62 THEN PRINT "NO DATA IN FILE":CLOSE
  267. 18900 RESUME 17300
  268. 18999 '***** SAVE FILE ERROR ROUTINES *****
  269. 19000 GOSUB 36000
  270. 19010 IF ERR=53 THEN PRINT:PRINT FLN$" NOT FOUND":RESUME 16400
  271. 19100 IF ERR=58 THEN PRINT:PRINT FLN$" EXISTS":RESUME 15300
  272. 19110 IF ERR=64 THEN PRINT:PRINT "BAD FILENAME":RESUME 15100
  273. 19120 IF ERR=53 THEN FLX$=FXN$:RESUME 16410 
  274. 19200 PRINT "ERROR # "ERR
  275. 19250 RESUME 17100
  276. 19260 RESUME NEXT
  277. 19270 GOSUB 36000:PRINT P$;"ERROR #"ERR;" LOG MAY BE LOST"P$;BEL$
  278. 19280 PRINT:PRINT P$;"SAVE LOG TO DISK NOW! ";P$:RESUME 7700
  279. 19300 PRINT:PRINT "ERASE LOG":PRINT  "ARE YOU SURE ?";
  280. 19400 GOSUB 28000
  281. 19500 IF YN=1 GOTO 19600 ELSE RETURN
  282. 19600 ERASE M
  283. 19700 DIM M(LMX,2)
  284. 19800 C=1:CO=0
  285. 19900 PRINT CLS$:PRINT:PRINT "LOG ERASED  "FRE(X$)" BYTES FREE"
  286. 19910 PRINT:PRINT
  287. 20000 RETURN
  288. 20100 GOSUB 36000:PRINT "EXIT TO BASIC AND DELETE LOG IN MEMORY"
  289. 20110 PRINT "ARE YOU SURE ?"
  290. 20120 GOSUB 28000
  291. 20130 IF YN=1 GOTO 20150
  292. 20135 A$="99"
  293. 20140 RETURN
  294. 20150 ON ERROR GOTO 0
  295. 20160 END
  296. 20200 '***** CLOCK ROUTINES FOR OSBORNE W/JG CLOCK****
  297. 20300 IF JG=(-1) THEN ADDR=PEEK(&H40)+256*PEEK(&H41) ELSE Y$="0":GOTO 22500
  298. 20400 IF ADDR > 61000! THEN Y$="0":GOTO 22500
  299. 20500 FOR N=ADDR+19 TO ADDR+50
  300. 20510 IF PEEK(N)=0 THEN 20550 ELSE NEXT
  301. 20550 IF PEEK(N-3)=&H39 AND PEEK(N-4)=&H31 THEN GOTO 20600
  302. 20560 Y$="0":GOTO 22500
  303. 20600 TH=PEEK(ADDR+3)
  304. 20700 TM=PEEK(ADDR+4)
  305. 20800 TH$=STR$(TH):TM$=STR$(TM)
  306. 20900 IF VAL(TH$) < 10 THEN TH$="0"+RIGHT$(TH$,1) ELSE TH$=RIGHT$(TH$,2)
  307. 21000 IF VAL(TM$) < 10 THEN TM$="0"+RIGHT$(TM$,1) ELSE TM$=RIGHT$(TM$,2)
  308. 21100 Y$=TH$+TM$
  309. 21200 DA=PEEK(ADDR)
  310. 21300 XO=PEEK(ADDR+1)
  311. 21350 YR=PEEK(ADDR+2)
  312. 22100 DA$=STR$(DA):XO$=STR$(XO):YR$=STR$(YR)
  313. 22200 IF VAL(DA$) < 10 THEN DA$="0"+RIGHT$(DA$,1) ELSE DA$=RIGHT$(DA$,2)
  314. 22300 IF VAL(XO$) < 10 THEN XO$="0"+RIGHT$(XO$,1) ELSE XO$=RIGHT$(XO$,2)
  315. 22400 DTE$=YR$+"/"+XO$+"/"+DA$
  316. 22500 RETURN
  317. 22600 '*****TOGGLE ROUTINES**********
  318. 22700 JG=JG*(-1):RETURN
  319. 22800 DP=DP*(-1):RETURN
  320. 22900 '***** HELP MENU***************
  321. 23000 GOSUB 36000
  322. 23200 PRINT CLS$:PRINT:PRINT P$;"MENU";P$
  323. 23300 PRINT " C  TO TOGGLE CLOCK
  324. 23400 PRINT " D  TO TOGGLE DUPE
  325. 23500 PRINT " M  FOR MAIN MENU
  326. 23700 GOSUB 36000:GOSUB 36000
  327. 23800 PRINT "OTHERWISE enter CALL, RST & TIME"
  328. 23900 GOSUB 36000:PRINT "NOTE: When an input is requested, hit <CR> for "
  329. 24000 PRINT "default value. In edit mode <CR> skips - no change"  
  330. 24100 PRINT:PRINT "HIT ANY KEY TO RESUME"
  331. 24200 YN$=INPUT$(1)
  332. 24300 RETURN
  333. 28000 PRINT " (Y/N) ?";
  334. 28100 YN$=INPUT$(1)
  335. 28200 IF YN$=CHR$(13) THEN YN=0:GOTO 28500
  336. 28300 IF YN$="N" OR YN$="n" THEN YN=(-1):GOTO 28500
  337. 28400 IF YN$="Y" OR YN$="y" THEN YN=1:GOTO 28500
  338. 28450 YN=255
  339. 28500 RETURN
  340. 30000 PRINT CLS$
  341. 30100 GOSUB 36000:PRINT "SEARCH COLUMN 1"
  342. 30200 PRINT:INPUT "ENTER STRING TO FIND";SF$
  343. 30600 PRINT CLS$:PRINT "SEARCHING"
  344. 30700 GOSUB 31710
  345. 30800 SFL=LEN(SF$)
  346. 30900 FOR I = 1 TO C
  347. 31000 IF SF$ = LEFT$(M(I,1),SFL) THEN GOSUB 31800
  348. 31100 NEXT I
  349. 31200 PRINT:PRINT "DONE ";
  350. 31300 GOSUB 28000
  351. 31400 IF YN=1 OR YN=0 GOTO 31700
  352. 31500 IF YN=(-1) GOTO 30100
  353. 31600 GOTO 31200
  354. 31700 RETURN
  355. 31710 PRINT "  # ";TAB(7);"ITEM ONE";TAB(26);"ITEM TWO"
  356. 31720 PRINT
  357. 31730 RETURN
  358. 31800 IF I < 10 THEN PRINT "  ";I;
  359. 31810 IF I > 9 AND I < 100 THEN PRINT " ";I;
  360. 31820 IF I > 99 THEN PRINT I;
  361. 31830 PRINT TAB(7);M(I,1);TAB(26);M(I,2)
  362. 31840 IF PF=1 GOTO 19500
  363. 31850 RETURN
  364. 35000 PRINT CLS$
  365. 35100 PRINT "REPLACE DISK IN DRIVE"
  366. 35200 PRINT "READY ? "
  367. 35300 GOSUB 28000
  368. 35400 RESET
  369. 35500 RETURN 
  370. 36000 PRINT:PRINT:PRINT:PRINT:RETURN
  371. 37000 PRINT:PRINT P$;CG$;P$
  372. 37010 GOSUB 28000
  373. 37020 IF YN=1 THEN PRINT WT$:PRINT FRE(X$)
  374. 37030 RETURN
  375. :PRINT:PRI