home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / hamradio / contest.zip / CONTEST.TB < prev    next >
Text File  |  1990-04-23  |  12KB  |  210 lines
  1. DEFINT A-Z
  2. MClr = 15 : MClrBG = 1 : PClr = 14 : PClrBG = 4 : KClr = 2: KClrBG = 8
  3. LClr = 14 : LClrBG = 1 : WClr = 30 : WcLRbg = 4 : QClr = 15 : QClrBG = 4
  4. SCLR  = 14 :SCLRBG = 5 :
  5.    color MClr,MClrBG
  6. 10 ON ERROR GOTO 1200
  7. 20 KEY OFF:G$="PC-HAM CONTEST LOGGING PROGRAM Version 3.42 (c) G3ZCZ 1990   "
  8.    CLS:WIDTH 80:PRINT G$:PRINT
  9.    :PRINT "IF TIME IS NOT SET TO UTC, STOP NOW AND SET THE CLOCK IN DOS"
  10. 30 K1=0: Print
  11. 40 BANDS=8:M9=4000:DIM W$(M9),F1(M9),B(BANDS),B1(BANDS):R1$="00":S1$="599":C$="?"
  12. 50 BLANK$="                                                                    "
  13.    Bar$= "════════════════════════════════════════════════════════════════════"
  14.    DIM CL$(10) : SPOS = 1 : srow = 40
  15. 60 C4$="RXWBMCFL*/Q?OP+G":L0$=BLANK$:QS$="-":QR$=QS$:R$=R1$:S$=S1$:L1$=L0$:L2$=L0$:L3$=L0$:L4$=L0$
  16. 70 L5$=L0$:L6$=L0$:L7$=L0$:L8$=L0$:L13$=L0$:L12$=L0$:L11$=L0$:L10$=L0$:L9$=L0$
  17. 80 FOR I%=1 TO BANDS:READ B(I%):NEXT:DATA 1,4,16,64,256,1024,4096,16384
  18. 90 FOR I%=1 TO BANDS:READ B1(I%):NEXT:DATA 10,15,20,40,80,160,2,6
  19. 100 color PClr, PClrBG
  20. INPUT "Enter name of lOG file (D:NAME) Log type .LOG Assumed ",L$:IF L$="" THEN 100
  21. 110 GOSUB 880
  22. 120 GOSUB 930: color MClr,MClrBG : CLS
  23. 130 OPEN L$+".$$$" FOR OUTPUT AS #2
  24. 140 OPEN L$+".LOG" FOR INPUT AS #1:GOTO 160
  25. 150 GOSUB 420 :GOSUB 430 :GOSUB 460:GOTO 1000
  26. 160 LOCATE 23,1:PRINT "LOADING LAST ENTRY STRINGS":OPEN L$+".CHK" FOR INPUT AS #3
  27. 170 INPUT#3,L13$,L12$,L11$,L10$,L9$,L8$,L7$,L6$,L5$,L4$,L3$,L2$,L1$:CLOSE#3
  28. 180 PRINT "OPENING LOGBOOK ";L$: N4=0
  29. 190 IF EOF(1) THEN INPUT"Waiting,touch ENTER to continue ";A$:GOSUB 470:GOTO 1000
  30. 200 INPUT#1,D$,T$,B$,C$,R$,S$,M$,P$,QS$,QR$,X$ : PRINT N4,C$,X$:
  31.     IF C$="/*" THEN N4=N4-1 ELSE N4=N4+1
  32. 210 IF C$="/*" THEN C$=C8$:GOSUB 300:W$(J)=" ":F1(J)=F1(J)-B(B%):C$="/*":GOTO 240
  33. 220 GOSUB 300:W$(J)=C$:F=VAL(B$):FOR Q%=1 TO BANDS:IF INT(F)=B1(Q%) THEN F1(J)=F1(J)+B(Q%):B%=Q%:GOTO 240
  34. 230 NEXT
  35. 240 C8$=C$:WRITE#2,D$;T$;B$;C$;R$;S$;M$;P$;QS$;QR$;X$:GOTO 190
  36. 250 COLOR PClr, PClrBG:LOCATE 20,1:PRINT BLANK$;"  ":LOCATE 20,1:RETURN
  37. 260 L0$=BLANK$:MID$(L0$,6)=D$:MID$(L0$,15)=T$:MID$(L0$,20)=C$:MID$(L0$,32)=B$:MID$(L0$,36)=M$:MID$(L0$,40)=P$
  38. 270 IF C$="/*" THEN MID$(L0$,1)="-" ELSE N4$=STR$(N4):MID$(L0$,1)=MID$(N4$,2)
  39. 280 MID$(L0$,45)=R$:MID$(L0$,49)=S$:MID$(L0$,53)=QS$:MID$(L0$,55)=QR$:MID$(L0$,57)=X$:RETURN
  40. 290 T$=LEFT$(TIME$,2)+MID$(TIME$,4,2):D$=RIGHT$(DATE$,2)+"/"+LEFT$(DATE$,2)+"/"+MID$(DATE$,4,2):RETURN
  41. 300 J=0:IF C$="/*" THEN 380
  42. 310 FOR I%=1 TO LEN(C$):A$=MID$(C$,I%,1):J=J+(ASC(A$)-47):NEXT:J=J*ASC(LEFT$(C$,1)):IF J<0 THEN J=0
  43. 320 IF J>M9 THEN J = J-M9 : GOTO 320
  44. 330 IF LEN(W$(J))<1 THEN 380
  45. 340 IF LEFT$(W$(J),1)=" " THEN 380
  46. 350 IF LEFT$(W$(J),LEN(C$))=C$ THEN 370
  47. 360 J=J+1:GOTO 320
  48. 370 I=0:RETURN
  49. 380 I=1:RETURN
  50. 390 PRINT "REPORT RECEIVED - "+S1$+"+" ;
  51.     INPUT A$:IF A$="" THEN 400 ELSE X$=S1$+A$
  52. 400 RETURN
  53. 410 GOSUB 250:INPUT "REPORT SENT     ";S$:IF S$>"599" THEN 410 ELSE RETURN
  54. 420 GOSUB 250:INPUT "POWER (watts)   ";P$:IF P$<"0" THEN 420 ELSE RETURN
  55. 430 GOSUB 250:INPUT "BAND            ";F : IF F>160 THEN 430
  56. 440 FOR I%=1 TO BANDS:IF INT(F)=B1(I%) THEN 450 ELSE NEXT: LOCATE 22,1:FOR I%=1 TO BANDS:PRINT B1(I%);" ";:NEXT:GOTO 430
  57. 450 B$=MID$(STR$(F),2):B%=I%:GOSUB 730:RETURN
  58. 460 GOSUB 250:INPUT "MODE            ";M$: IF M$="" THEN 460
  59. 470 IF M$="SSB" THEN S1$="59" ELSE S1$="599"
  60. 480 RETURN
  61. 490 GOSUB 250:INPUT "CALL SIGN       ";A$ : JOE = 0: GOTO 500
  62. 495 GOSUB 250:INPUT "WHICH NUMBER (0-9) ";I
  63.     IF I>10 OR  I<0 THEN A$= "" ELSE A$ = CL$(I) : JOE = 1
  64. 500 IF A$="" THEN 580 :
  65. 502 IF LEFT$(A$,4)="CALL" THEN 490
  66.     IF LEFT$(A$,1)="" THEN A$=LEFT$(A$,LEN(A$)):GOTO 500
  67.     IF JOE = 1 THEN 510
  68.     FOR I = 0 TO 9 : IF CL$(I) = A$ THEN 510 ELSE NEXT I
  69.     'IF CL < 10 THEN CL$(CL) = A$ : CL = CL+1 : GOTO 509
  70.     FOR I = 1 TO 9 : CL$(I-1) = CL$(I) : NEXT I :
  71.     IF LEN(A$) > 10 THEN A$ = LEFT$(A$,10)
  72.     CL$(9) = A$
  73. 509 GOSUB 1635
  74. 510 LOCATE 22,1:PRINT BLANK$;"  ": LOCATE 22,1:C$=A$:GOSUB 300:IF I=0 THEN 530
  75. 520 PRINT "OK":GOTO 580
  76. 530 F2=F1(J): COLOR Wclr, Wclrbg : PRINT "WORKED on ";
  77. 540 FOR Q%=BANDS TO 1 STEP -1: IF F2<B(Q%) THEN 570
  78. 550 PRINT B1(Q%);" ";:F2=F2-B(Q%):
  79.     IF B1(Q%)=INT(F) THEN PRINT "DUPLICATE";CHR$(7);
  80. 560 IF F2>=B(Q%) THEN 540
  81. 570 NEXT
  82. 580 cOLOR MClr  ,MClrBG:  IF P2=1 THEN LPRINT C$
  83. 590 RETURN
  84. 600 GOSUB 250:INPUT "ARE YOU SURE ";A$ :IF A$="" THEN RETURN
  85. 610 IF N4=<1 THEN GOSUB 250 : PRINT "CAN'T F***** A ZERO ENTRY":RETURN
  86. 620 IF A$=""OR LEFT$(A$,1) <> "Y" THEN RETURN
  87. 630 C$=C8$:GOSUB 300:F1(J)=F1(J)-B(B%):IF F1(J)<=0 THEN W$(J)=" "
  88. 640 C$="/*":GOTO 680
  89. 650 IF LEN(X$)=0 THEN 660 ELSE IF LEFT$(C$,1)="?" THEN 660 ELSE 670
  90. 660 COLOR Wclr, Wclrbg: LOCATE 22,1:PRINT "GET THE DATA FIRST";CHR$(7);:RETURN
  91. 670 GOSUB 290:C8$=C$:GOSUB 300: F1(J)=F1(J)+B(B%):W$(J)=C$:GOSUB 1070
  92. 680 WRITE#2,D$;T$;B$;C$;R$;S$;M$;P$;QS$;QR$;X$
  93. 690 IF C$="/*" THEN 700 ELSE N4=N4+1:GOTO 710
  94. 700 N4=N4-1:IF N4<1 THEN N4=1
  95. 710 GOSUB 260:L13$=L12$:L12$=L11$:L11$=L10$:L10$=L9$:LOCATE 1,5:PRINT G$
  96. 720 L9$=L8$:L8$=L7$:L7$=L6$:L6$=L5$:L5$=L4$:L4$=L3$:L3$=L2$:L2$=L1$:L1$=L0$:IF P1 = 1 THEN LPRINT L0$
  97. 730 GOSUB 740:C$="?":R$=R1$:S$=S1$:X$="":RETURN
  98. 740 COLOR LClr,LClrBG
  99.     I=3:GOSUB 780:PRINT L13$:I=4:GOSUB 780:PRINT L12$:I=5:GOSUB 780:PRINT L11$:I=6:GOSUB 780:PRINT L10$
  100. 750 I=7:GOSUB 780:PRINT L9$:I=8:GOSUB 780:PRINT L8$:I=9:GOSUB 780:PRINT L7$:I=10:GOSUB 780:PRINT L6$
  101. 760 I=11:GOSUB 780:PRINT L5$:I=12:GOSUB 780:PRINT L4$:I=13:GOSUB 780:PRINT L3$:I=14:GOSUB 780:PRINT L2$
  102. 770 I=15:GOSUB 780:PRINT L1$:
  103.     ' COLOR PClr, PClrBG :
  104.     GOSUB 1635: RETURN
  105. 780 LOCATE I,1:PRINT "║";BLANK$;"║"; :LOCATE I,2: PRINT ; : RETURN
  106. 790 GOSUB 250:INPUT "ARE YOU SURE ";A$:IF A$="" THEN RETURN
  107. 800 IF LEFT$(A$,1)<>"Y" THEN RETURN
  108. 810 CLS:PRINT "SAVING LAST ENTRY STRINGS BEFORE CLOSING":OPEN L$+".CHK" FOR OUTPUT AS #3
  109. 820 WRITE#3,L13$;L12$;L11$;L10$;L9$;L8$;L7$;L6$;L5$;L4$;L3$;L2$;L1$
  110. 830 CLOSE#3:CLOSE#1:CLOSE#2
  111. 840 KILL L$+".BAK"
  112. 850 NAME L$+".LOG" AS L$+".BAK"
  113. 860 NAME L$+".$$$" AS L$+".LOG"
  114. 870 GOTO 1350 : REM END
  115. 880 INPUT "Do you want a running log printed out (Y/N) "; A$: IF A$="" THEN 880
  116. 890 IF LEFT$(A$,1)="Y" THEN P1 = 1 ELSE IF LEFT$(A$,1)="N" THEN P1 = 0 ELSE 880
  117. 900 INPUT "Do you want CALL SIGNS printed out (Y/N) "; A$: IF A$="" THEN 900
  118. 910 IF LEFT$(A$,1)="Y" THEN P2 = 1 ELSE IF LEFT$(A$,1)="N" THEN P2 = 0 ELSE 900
  119. 920 RETURN
  120. 930 IF K1 = 1 THEN 970
  121. 940 KEY 1,"GRAB  "+CHR$(13): KEY 2,"BAND  "+CHR$(13):KEY 3,"CALL  "+CHR$(13):KEY 4, "*QRT  "+CHR$(13):KEY 5,"RPT RX "+CHR$(13)
  122. 950 KEY 6,"FUDGE "+CHR$(13): KEY 7,"XMT RPT"+CHR$(13):KEY 8,"/PX CHK"+CHR$(13):
  123.     KEY 9, "LOG   "+CHR$(13):KEY 10,"+MORE "+CHR$(13): K1=1
  124. 960 GOTO 990
  125. 970 KEY 1,"WATTS "+CHR$(13): KEY 2,"MODE  "+CHR$(13):KEY 3,"?CLN  "+CHR$(13):KEY 4, "PRINT "+CHR$(13):KEY 5,"OOPS  "+CHR$(13)
  126. 980 KEY 6,"      "+CHR$(13): KEY 7,"        "+CHR$(13):KEY 8,"        "+CHR$(13):
  127.     KEY 9, "      "+CHR$(13):KEY 10,"+MORE "+CHR$(13): K1=0
  128. 990 color KClr, KClrBG : KEY ON: color MClr,MClrBG : RETURN
  129. 1000 GOSUB 1090: GOSUB 730 :GOSUB 470
  130. 1010 COLOR PClr, PClrBG: LOCATE 1,1:PRINT G$;L$
  131.      LOCATE 2,1: COLOR LClr,LClrBG
  132.   PRINT "╔═NR════DATE═══TIME═══CALL════BAND═MODE═PWR══RX══TX══Q═R══REPORT═════╗"
  133.      LOCATE 16,1:PRINT  "╚";Bar$;"╝" :
  134.      COLOR QClr,QClrBG :LOCATE 19,1:PRINT "╚";Bar$;"╝"
  135. 1020  LOCATE 17,1:
  136.   PRINT "╔═════════════════════════CURRENT ENTRY══════════════════════════════╗"
  137.       GOSUB 290:GOSUB 260
  138. 1030 MID$(L0$,1)= STR$(N4+1): GOSUB 1080
  139. 1040 COLOR PClr, PClrBG: GOSUB 250:
  140.      INPUT "QRU ";A$:LOCATE 22,1:PRINT BLANK$;"  ":IF A$=""THEN 1040
  141. 1050 FOR J2%=1 TO LEN(C4$):IF LEFT$(A$,1)=MID$(C4$,J2%,1) THEN 1060 ELSE NEXT:GOTO 1040
  142. 1060 GOSUB 250:
  143.   ON J2% GOSUB 390,410,420,430,460,490,600,650,790,1130,1080,1070,1370,880,930,495:GOTO 1010
  144. 1070  cOLOR MClr  ,MClrBG:
  145.      LOCATE 21,1:PRINT BLANK$;"  ":PRINT BLANK$;"  ":PRINT BLANK$;"  ":RETURN
  146. 1080 LOCATE 18,1:COLOR QClr,QClrBG : PRINT "║";L0$; "║":
  147.      color MClr,MClrBG : RETURN
  148. 1090 color MClr,MClrBG : CLS: color KClr, KClrBG : KEY ON: color MClr,MClrBG : RETURN
  149. 1130 GOSUB 250:INPUT "ARE YOU SURE ";A$:IF A$="" THEN RETURN
  150. 1140 INPUT "WHICH PREFIX ";A$:IF LEN(A$)<1 THEN A$="*"
  151. 1150 color PClr,PClrBG :CLS:LOCATE 2,1:PRINT Bar$ :LOCATE 1,1:PRINT G$;L$
  152.      LOCATE 3,1
  153. 1160 I%=0:FOR Q=1 TO M9:IF LEN(W$(Q))<=2 THEN 1190
  154. 1170 IF A$="*" THEN 1180 ELSE IF A$=LEFT$(W$(Q),LEN(A$)) THEN 1180 ELSE 1190
  155. 1180 PRINT W$(Q),:I%=I%+1:IF I%=4 THEN I%=0:PRINT
  156. 1190 NEXT:PRINT:INPUT "READY WHEN YOU ARE, HIT ENTER TO CONTINUE";A$:
  157.      GOSUB 1090:GOSUB 740:RETURN
  158. 1200 IF ERR = 64 OR ERR = 67 THEN PRINT "BAD FILE NAME ERROR" : GOTO 1640
  159. 1210 IF ERL = 140 THEN OPEN L$+".LOG" FOR OUTPUT AS #3:CLOSE#3:OPEN L$+".LOG" FOR INPUT AS #1:RESUME 150
  160. 1220 IF ERR = 61 THEN PRINT "Yuk Yuk Yuk DISK FULL ERROR - You may have blown it" :GOTO 1640
  161. 1230 IF ERL=160 THEN PRINT "CHECK LIST ERROR, RECOVERING....":RESUME 180
  162. 1240 IF ERL = 580 THEN PRINT "PRINTER ERROR, ABORTING PRINTING":RESUME 590
  163. 1250 IF ERL = 720 THEN RESUME 730
  164. 1260 IF ERL = 840 THEN RESUME 850
  165. 1270 IF ERL = 1610 AND ERR = 70 THEN PRINT "DISK WRITE PROTECT ERROR":GOTO 1640
  166. 1280 IF ERR = 62 AND ERL = 200 THEN GOSUB 730:INPUT"Waiting,touch ENTER to continue ";A$:RESUME 1000
  167. 1290 IF ERR = 53 THEN PRINT "LOG FILE DOES NOT EXIST ON DEFAULT DISK DRIVE":GOTO 1640
  168. 1300 IF ERR = 72 THEN PRINT "DISK MEDIA ERROR":GOTO 1640
  169. 1310 IF ERR = 71 THEN PRINT "DISK NOT READY ERROR":GOTO 1640
  170. 1320 IF ERR = 58 THEN 1640
  171. 1330 PRINT "ERROR ";ERR;" AT LINE ";ERL:CLOSE:GOTO 1640
  172. 1340 REM RESUME 750:REM CLOSE DOWN IN AN ORDERLY MANNER
  173. 1350 INPUT "Is the contest over (Y/N) ";A$: IF LEN(A$)<1 THEN 1350
  174. 1360 IF LEFT$(A$,1)="Y" THEN 1390 ELSE 1640
  175. 1370 INPUT "What is the number of lost calls (to be added to the memory) ";O:IF O <0 THEN 1370
  176. 1380 N4 = N4+O : RETURN
  177. 1390 PRINT "CONVERTING (CLEANING UP) CONTEST LOG TO STANDARD LOG"
  178. 1400 OPEN L$+".LOG" FOR INPUT AS #1
  179. 1410 OPEN L$+".$$$" FOR OUTPUT AS #2
  180. 1420 INPUT "Do you want the contacts numbered (Y/N) ";AA$: IF LEN(AA$)=0 THEN 1420
  181. 1430 IF LEFT$(AA$,1)="Y" THEN N0=1 ELSE N0=0:IF LEFT$(AA$,1)<>"N" THEN 1420
  182. 1440 INPUT "What is the name of the contest ";X$
  183. 1450 N=1:T$=" ":B$=" ":C$="-CONTEST":R$=" ":S$=" ":P$=" ":QS$=" ":QR$=" ":GOSUB 1610
  184. 1460 IF EOF(1) THEN 1520 ' GET FIRST ENTRY
  185. 1470 GOSUB 1570:GOSUB 1580:IF C1$="/*" THEN GOSUB 1630: GOTO 1460 'REM DONT SAVE FUDGE FLAG OR PREVIOUS LINE
  186. 1480 IF EOF(1) THEN 1510 ' GET SUBSEQUENT ENTRIES
  187. 1490 GOSUB 1570:IF C1$="/*" THEN GOSUB 1630:GOTO 1460 'REM DONT SAVE FUDGE FLAG OR PREVIOUS LINE
  188. 1500 GOSUB 1590:GOSUB 1580:GOTO 1480
  189. 1510 GOSUB 1590:PRINT :PRINT N9;"Entries were corrected/deleted"
  190. 1520 CLOSE#1 : CLOSE#2
  191. 1530 NAME L$+".LOG" AS L$+".RUN"
  192. 1540 NAME L$+".$$$" AS L$+".LOG"
  193. 1550 GOTO 1640
  194. 1560 REM SUBROUTINES FOLLOW
  195. 1570 INPUT#1,D1$,T1$,B1$,C1$,R1$,S1$,M1$,P1$,QS1$,QR1$,X1$:RETURN
  196. 1580 D$=D1$:T$=T1$:B$=B1$:C$=C1$:R$=R1$:S$=S1$:M$=M1$:P$=P1$:QS$=QS1$:QR$=QR1$:X$=X1$:RETURN
  197. 1590 R$=MID$(X$,1,3):X$=MID$(X$,4,LEN(X$))
  198.      IF LEN(S1$) = 3 THEN 1600 ' ELSE TRANSFER LAST DIGIT FROM R TO X
  199.         X$ =  RIGHT$(R$,1)+X$ : R$=MID$(R$,1,2)
  200. 1600 IF N0=1 THEN N$=STR$(N):N$=MID$(N$,2):X$=N$+"-"+X$:N=N+1
  201. 1610 WRITE#2, D$;T$;B$;C$;R$;S$;M$;P$;QS$;QR$;X$
  202. 1620 PRINT D$;TAB(10);T$;TAB(15);C$;TAB(26);B$;TAB(30);R$;TAB(34);S$;TAB(38);M$;TAB(43);P$;TAB(48);QS$;TAB(50);QR$;TAB(52);X$:RETURN
  203. 1630 N9=N9+1:PRINT "ENTRY with ";C$;" DELETED":RETURN
  204. 1635 COLOR  SCLR,SCLRBG: LOCATE SPOS+3, srow: PRINT "╔══CALL STACK══╗"
  205. FOR I = 0 TO 9 : LOCATE SPOS+ I+4, srow: PRINT "║              ║"
  206.      LOCATE SPOS+ I+4, srow+1: PRINT 9-I;" ";CL$(9-I): NEXT I :
  207.      LOCATE SPOS+ I+4, srow: PRINT "╚══════════════╝"
  208.      COLOR PClr, PClrBG:RETURN
  209. 1640 COLOR 15,0 : CLS: END
  210.