home *** CD-ROM | disk | FTP | other *** search
/ Amiga Elysian Archive / AmigaElysianArchive.iso / bus_pers / ham.lha / CQWWDXLog_v1.0 < prev    next >
Text File  |  1990-08-29  |  25KB  |  790 lines
  1. 'August 1990. CQWWDXLog_1.0 was developed by George R. Leone, K6SG, a
  2. 'member of the River City Contesters and of the Sacramento Amiga Computer
  3. 'Club. Use this public domain program at your own risk. The developer assumes
  4. 'no responsibility for any losses whatsoever incurred by its use nor does he
  5. 'assume any for upkeep or debugging of the program. It may be freely copied 
  6. 'and distributed but not sold for profit.
  7.  
  8. CLEAR ,350000&,2048 
  9. DEFINT a-Z
  10.    
  11.   ans$="":b$="":band$="":bn$="":bd$="":bz$="":c$="":dayt$="":   
  12.   f$="":her.cal$="":her.nr$="":his.cal$="":his.msg$="":his.nr$="":
  13.   hm$="":hr$="":hrs$="":i$="":min$="":my$="":
  14.   my.call$="":my.date$="":my.nr$="":my.msg$="":my.time$="":nat$="":  
  15.   poynt$="":prev.time$="":pt$=""::sw$="CM":temp$="": 
  16.   time.prev$="":time.on$="":tot$="":tyme$="":on.time$="":
  17.   a=0:col=0:ctr=0:ctr2=0:ctryctr=0:cwpm=0:E=0:ELE=0:f=0:
  18.   hrs=0:hrs.mins=0:i=0:incr%=0:line.ptr=0:loop=0:min=0:
  19.   min=0:multctr=0:my.div=0:my.row=0:my.mins=0:
  20.   on.min=0:ptr=0:pts=0:ptsctr=0:prev.mins=0:qso.ptr=0:   
  21.   row=0:temp.mins=0:zctr=0:zonectr=0:fortyeight.hrs=2880&:on.time.mins=0:   
  22.   tot!=0:
  23.  
  24.  DIM q$(3000,14),pfx$(1000),ctry$(1000),cnt$(1000),bz$(6,40)     
  25.  
  26.  'Read Prefix table file
  27.  
  28. PRINT TAB(5)  "Reading prefix/country/continent library...";
  29.   p=0  ' initialize array subscript
  30.   OPEN "WWPfxCtryCont.lib" FOR INPUT AS #1
  31.  
  32.  WHILE NOT EOF(1)
  33.    p=p+1
  34.    INPUT #1, pfx$(p),ctry$(p),cnt$(p)   'builds prefix, country, continent arrays 
  35.   WEND
  36.   CLOSE
  37.   tablesize=p 
  38.                             
  39. 'fill band-zone array with 40 zones for each band                  
  40.   FOR b = 1 TO 6 :RESTORE
  41.   FOR Z = 1 TO 40
  42.     READ bz$(b,Z)
  43.     NEXT Z
  44.    NEXT b 
  45.   
  46.   COLOR 3: PRINT "Done" : COLOR 1
  47.  
  48.   SCREEN 1,640,200,3,2
  49.   WINDOW 2,"                    CQWW DX CONTEST PROGRAM",(0,0)-(631,186),8,1
  50.   f = 800                      
  51.   wpm = 18                    
  52.   'Calculate speed, dot time
  53.   IF wpm < 13 THEN cwpm=13 ELSE cwpm =wpm
  54.   s!= 21.84/cwpm                         'declares s single precision integer
  55.   IF wpm >= 13 THEN ELE=s! ELSE ELE = (43.68 -1.68 * wpm) / wpm
  56.  
  57.   CLS:LOCATE 7,10:INPUT"Enter your Call Sign: ";my.call$
  58.   my.call$ = my.call$ + " ":my.call$ = UCASE$(my.call$)
  59.   LOCATE 9,10:INPUT"Zone: ";my.zone$
  60.   
  61. year.agn: 
  62.   LOCATE 11,10:INPUT "Enter last two digits of contest year ";yr$
  63.   IF yr$ = "" THEN year.agn
  64.  
  65. mode: LOCATE 13,34:PRINT "    "
  66.   LOCATE 13,10:INPUT "Enter mode - SSB or CW ";mode$
  67.   mode$=UCASE$(mode$)
  68.   IF mode$ <> "SSB" AND mode$ <> "CW" THEN GOTO mode
  69.   IF mode$="CW" THEN my.report$="599" 
  70.   IF mode$="SSB" THEN my.report$="59"
  71.   my.msg$ = my.report$ + my.zone$
  72.  
  73. get.ans:CLS
  74.   LOCATE 6,16
  75.   INPUT "Is this the beginning of the Contest Y/N ";ans$
  76.   ans$ = UCASE$(ans$)
  77.   IF ans$ <> "Y" AND ans$ <> "N" THEN get.ans
  78.   IF ans$ = "N" THEN GOSUB part.fill ELSE GOSUB full.fill  
  79.   GOSUB sign.in
  80.   GOSUB prt.header
  81.   her.cal$="START":GOTO ctrycheck      'False start. Expedites startup time
  82.    
  83.   GOTO his.call.in
  84.  
  85. band.in: band$=""
  86.   LINE (0,80)-(399,87),0,bf
  87.   LOCATE 11,1:INPUT "Enter Band  ";band$
  88.   IF band$ = "1.8" OR band$ = "3.5" OR band$ = "7.0" OR band$ = "14" OR band$ = "21" OR band$ = "28" THEN GOSUB bandit:GOTO his.call.in
  89.   COLOR 5,0:LOCATE 12,3:PRINT band$;" is not a valid band, please Re-Enter."
  90.   BEEP:BEEP: COLOR 1,0
  91.   GOTO band.in
  92.  
  93. his.call.in:LINE (0,80)-(399,183),0,bf 
  94.  
  95. his.call.in2:
  96.   my$ = "":her.cal$=""
  97.   LOCATE 12,1:PRINT "His Call or Band (-1 to quit): ";           'her.cal$
  98.   row = 12:col = 32:GOSUB gk
  99.   her.cal$ = my$ 
  100.   IF her.cal$ = "" THEN LOCATE 13,5:PRINT "Get a Call or part of call!":GOTO his.call.in2
  101.   LOCATE 13,5:PRINT STRING$(27," ")
  102.   IF her.cal$ = "-1" THEN GOSUB sign.out:GOTO wrap.today
  103.   IF her.cal$ = "1.8" OR her.cal$ = "3.5" OR her.cal$ = "7.0" OR her.cal$ = "14" OR her.cal$ = "21" OR her.cal$ = "28" THEN band$ = her.cal$:GOSUB bandit:GOTO his.call.in
  104.   her.cal$ = UCASE$(her.cal$)
  105.   i = 0
  106.   dup.loop:i = i + 1
  107.   IF i > qso.ptr THEN GOTO his.nr           'Call sign is not a duplicate
  108.   IF q$(i,1) = band$ AND q$(i,4) = her.cal$ THEN GOSUB f6 ELSE GOTO dup.loop
  109.   LOCATE 13,5:COLOR 3,0:PRINT "***DUPE DUPE***":COLOR 1,0
  110.   LINE (0,88)-(399,95),0,bf
  111.   GOTO his.call.in
  112.   
  113. his.nr:my$ = "":LINE (0,96)-(399,103),0,bf
  114.   IF mode$="CW" THEN rst$= "599" 
  115.   IF mode$="SSB" THEN rst$ = "59"                  
  116.   LOCATE 14,20:PRINT "His report: "; rst$       'her.msg$   
  117.   row = 14:col = 35:GOSUB gk
  118.   her.zone$=my$
  119.   her.msg$ = rst$+her.zone$ 
  120.  
  121. his.call.in3:my$ = "" 
  122.   LOCATE 17,5:COLOR 3:PRINT "Correct call or press RETURN: ";    'her.call$          'correct her.cal$
  123.   row = 17:col = 37:GOSUB gk
  124.   her.call$=my$
  125.   her.call$ = UCASE$(her.call$)
  126.   IF her.call$ <> "" AND her.call$ <> " " THEN her.cal$=my$   
  127.   her.cal$=UCASE$(her.cal$):COLOR 1 
  128.   LINE (0,128)-(430,135),0,bf
  129.  
  130.   i = 0
  131. dup.loop3:i = i + 1  
  132.   IF i > qso.ptr THEN GOTO zonecheck2             
  133.   IF q$(i,1) = band$ AND q$(i,4) = her.call$ THEN GOSUB f6 ELSE GOTO dup.loop3
  134.   LOCATE 13,5:COLOR 3,0:PRINT "***DUPE DUPE***.":COLOR 1,0
  135.   LINE (0,88)-(399,95),0,bf
  136.   GOTO his.call.in
  137.   GOTO zonecheck2
  138.  
  139. loop1: 
  140.   my.date$ = LEFT$(DATE$,6)
  141.   my.date$ = my.date$ + RIGHT$(DATE$,2) 
  142.   my.time$ = LEFT$(TIME$,5)
  143.  
  144. ctrycheck: 
  145.   k=0:l=0 : tablesize=p:true = -1
  146.   her.cal$=UCASE$(her.cal$)
  147.   thispfx$=LEFT$(her.cal$,4)
  148.   k=4:inlist = NOT true                    
  149.    WHILE k > 0  AND inlist = NOT true            
  150.     ckpfx$=LEFT$(thispfx$,k)
  151.     low=1 : high=tablesize : inlist = NOT true
  152.      WHILE low <= high AND inlist = NOT true
  153.      l=(low+high)/2
  154.      IF ckpfx$ = pfx$(l) THEN  thisctry$=ctry$(l):cntint$=cnt$(l):inlist = true
  155.     IF ckpfx$ =< pfx$(l) THEN high=l-1 ELSE low=l+1
  156.       WEND
  157.    k=k-1
  158.    WEND                                                        
  159.  
  160. multcheck:
  161.   IF qso.ptr <> 0 THEN GOTO ckmore
  162.   IF qso.ptr = 0 THEN mult$=thisctry$ 
  163.   GOTO prt.it
  164.   
  165. ckmore: m=0
  166.  ckit:
  167.   m=m+1
  168.    IF  m = qso.ptr+1 THEN mult$=thisctry$: GOTO prt.it
  169.    IF q$(m,1) = band$ AND q$(m,8) = thisctry$ THEN mult$ = "      " :GOTO prt.it
  170.    GOTO ckit
  171.  
  172. prt.it:
  173.   IF her.cal$ = "START" THEN GOTO band.in
  174.   IF thisctry$ = "W" THEN mult$="": pt$ = "0":GOTO prt.it1
  175.   IF thisctry$ <> "W" AND cntint$ = "NA" THEN pt$="2" ELSE pt$="3"
  176.  
  177. prt.it1:
  178.   GOSUB prt.this.contact                            
  179.   GOSUB correct
  180.   GOSUB gk
  181.   GOTO put.routine
  182.      
  183. gk:i$= INKEY$: IF i$="" THEN gk
  184.   i = ASC(i$)
  185.   IF i = 13 AND sw$ = "CM" THEN GOTO exit1
  186.   IF i = 28 THEN GOSUB key28:GOSUB calc.speed:GOTO gk
  187.   IF i = 29 THEN GOSUB key29:GOSUB calc.speed:GOTO gk
  188.   IF i = 33 AND sw$ = "CM" THEN GOSUB s1:GOTO gk     's1 his corrected call + r
  189.   IF i = 35 AND sw$ = "CM" THEN GOSUB s3:GOTO gk     's3 qrl?
  190.   IF i = 36 AND sw$ = "CM" THEN GOSUB s4:GOTO gk     's4 qrl pse qsy 
  191.   IF i = 37 AND sw$ = "CM" THEN GOSUB s5:GOTO gk     's5 ?
  192.   IF i = 64 AND sw$ = "CM" THEN GOSUB s2:GOTO gk     's2 r + msg
  193.   IF i = 127 AND sw$ = "CM" THEN GOTO delet   
  194.   IF i = 129 AND sw$ = "CM" THEN GOSUB f1:GOTO gk      'F1 cq
  195.   IF i = 130 AND sw$ = "CM" THEN GOSUB f2:GOTO gk      'F2 msg
  196.   IF i = 131 AND sw$ = "CM" THEN GOSUB f3:GOTO gk      'F3 r + call
  197.   IF i = 132 AND sw$ = "CM" THEN GOSUB f4:GOTO gk      'F4 my call 
  198.   IF i = 133 AND sw$ = "CM" THEN GOSUB f5:GOTO gk      'F5 his call
  199.   IF i = 134 AND sw$ = "CM" THEN GOSUB f6:GOTO gk      'F6 qso b4
  200.   IF i = 135 AND sw$ = "CM" THEN GOSUB f7:GOSUB ff7:GOSUB zonecheck1:GOSUB correct:GOTO gk   'F7 nr?
  201.   IF i = 136 AND sw$ = "CM" THEN GOSUB f8:GOTO gk      'F8 my nr
  202.   IF i = 11 AND sw$ = "CC" THEN COLOR 2,6:LOCATE 13,56:PRINT "Contest Mode  ":PALETTE 0,.1,.3,.6:COLOR 1,0:sw$ = "CM":GOTO his.call.in 
  203.   IF i = 11 AND sw$ = "CM" THEN COLOR 2,6:LOCATE 13,56:PRINT "Chit Chat Mode":PALETTE 0,0,0,0:sw$ = "CC":GOTO gk 
  204.  
  205.   IF sw$ = "CC" THEN GOSUB 1000:LOCATE 15,5:COLOR 1,2:my$ = my$ + i$:i$ = "":GOTO gk    'PRINT my$:                 
  206.   my$ = my$ + i$:i$ = ""
  207.   LOCATE row,col:PRINT my$:GOTO gk
  208.  
  209. exit1:RETURN
  210.  
  211. f1:LINE (0,168)-(279,175),0,bf:COLOR 1,0
  212.   f$ = "cq test " + my.call$ + my.call$ + "test"    
  213.   LOCATE 22,10:PRINT f$    
  214.   ctr2 = LEN(f$)
  215.   FOR loop = 1 TO ctr2
  216.   i$ = MID$(f$,loop,1)
  217.   GOSUB 1000
  218.   NEXT:RETURN   
  219.  
  220. f2:LINE (0,168)-(335,175),0,bf:COLOR 1,0
  221.   IF mode$="CW" THEN my.report$="599" ELSE my.report$="59"  
  222.   f$ = her.cal$ + " " +"5nn" + my.zone$
  223.   LOCATE 22,10:PRINT f$
  224.   ctr2 = LEN(f$)
  225.   FOR loop = 1 TO ctr2
  226.   i$ = MID$(f$,loop,1)
  227.   GOSUB 1000
  228.   NEXT:RETURN
  229.  
  230. f3:LINE (0,168)-(399,183),0,bf:COLOR 1,0
  231.   f$ = " r " + my.call$ + "test"
  232.   LOCATE 22,10:PRINT f$
  233.   ctr2 = LEN(f$)
  234.   FOR loop = 1 TO ctr2
  235.   i$ = MID$(f$,loop,1)
  236.   GOSUB 1000
  237.   NEXT:RETURN     
  238.  
  239. f4:LINE (0,168)-(279,175),0,bf:COLOR 1,0
  240.   f$ = my.call$
  241.   LOCATE 22,10:PRINT f$
  242.   ctr2 = LEN(f$)
  243.   FOR loop = 1 TO ctr2
  244.   i$ = MID$(f$,loop,1)
  245.   GOSUB 1000
  246.   NEXT:RETURN  
  247.  
  248. f5:LINE (0,168)-(279,175),0,bf:COLOR 1,0
  249.   f$ = her.cal$
  250.   LOCATE 22,10:PRINT f$
  251.   ctr2 = LEN(f$)
  252.   FOR loop = 1 TO ctr2
  253.   i$ = MID$(f$,loop,1)
  254.   GOSUB 1000
  255.   NEXT:RETURN  
  256.  
  257. f6:       
  258.   f$ = her.cal$ + " qso b4 " + my.call$ + "test"
  259.   ctr2 = LEN(f$)
  260.   FOR loop = 1 TO ctr2
  261.   i$ = MID$(f$,loop,1)
  262.   GOSUB 1000
  263.   NEXT:RETURN
  264.  
  265. f7:LINE (0,160)-(279,167),0,bf:COLOR 1,2
  266.   f$ =  "nr? "
  267.   ctr2 = LEN(f$)
  268.   FOR loop = 1 TO ctr2
  269.   i$ = MID$(f$,loop,1)
  270.   GOSUB 1000
  271.   NEXT:RETURN
  272.  
  273. f8:LINE (0,160)-(279,167),0,bf:COLOR 1,2
  274.   f$ =  "5nn" + my.zone$
  275.   ctr2 = LEN(f$)
  276.   FOR loop = 1 TO ctr2
  277.   i$ = MID$(f$,loop,1)               
  278.   GOSUB 1000
  279.   NEXT:RETURN   
  280.  
  281. s1: 
  282.   f$ = her.cal$ + " r " + my.call$ + "test"
  283.   ctr2 = LEN(f$)
  284.   FOR loop = 1 TO ctr2
  285.   i$ = MID$(f$,loop,1)
  286.   GOSUB 1000
  287.   NEXT:RETURN
  288.  
  289. s2:LINE (0,168)-(279,175),0,bf:COLOR 1,0   
  290.   f$ = "r " + "5nn" + my.zone$
  291.   LOCATE 22,10:PRINT f$
  292.   ctr2 = LEN(f$)
  293.   FOR loop = 1 TO ctr2
  294.   i$ = MID$(f$,loop,1)
  295.   GOSUB 1000
  296.   NEXT:RETURN   
  297.  
  298. s3:
  299.   f$ = "qrl? "
  300.   ctr2 = LEN(f$)
  301.   FOR loop = 1 TO ctr2
  302.   i$ = MID$(f$,loop,1)
  303.   GOSUB 1000
  304.   NEXT:RETURN
  305.  
  306. s4:
  307.   f$ = "qrl pse qsy "+ my.call$
  308.   ctr2 = LEN(f$)
  309.   FOR loop = 1 TO ctr2
  310.   i$ = MID$(f$,loop,1)
  311.   GOSUB 1000
  312.   NEXT:RETURN
  313.  
  314. s5:
  315.   f$ = "?"
  316.   ctr2 = LEN(f$)
  317.   FOR loop = 1 TO ctr2
  318.   i$ = MID$(f$,loop,1)
  319.   GOSUB 1000
  320.   NEXT:RETURN
  321.  
  322. ff7:my$ = "":LINE (0,80)-(399,183),0,bf
  323.   LOCATE 14,20:PRINT "His report: ";       'her.msg$
  324.   row = 14:col = 32:GOSUB gk
  325.   mes$=my$
  326.   rst$=LEFT$(mes$,3)
  327.   her.zone$=RIGHT$(mes$,2)
  328.   her.msg$=rst$+her.zone$
  329.   GOSUB prt.this.contact:LINE (0,80)-(399,183),0,bf
  330.   RETURN
  331.   
  332. zonecheck1:  
  333.   IF qso.ptr = 0 THEN nu.zone$=her.zone$:GOTO loop1
  334. zonecheck2:   u=0
  335. zonecheck: u = u + 1
  336.   IF q$(u,1) = band$ AND q$(u,7) = her.zone$ THEN nu.zone$="  " :GOTO loop1
  337.   IF q$(u,1) = band$ AND q$(u,7) <> her.zone$ THEN zonecheck 
  338.   IF u > qso.ptr THEN nu.zone$=her.zone$:GOTO loop1
  339.   GOTO zonecheck
  340.   
  341.   
  342. ret3:  LINE (63,72)-(640,79),0,bf
  343.   GOSUB prt.this.contact:LINE (0,80)-(399,183),0,bf
  344.   RETURN
  345.   ptr=0 
  346.  
  347. delet:LINE (0,80)-(399,183),0,bf
  348.   LINE (63,72)-(640,79),0,bf
  349.   GOTO his.call.in2
  350.  
  351. bandit:LINE (63,72)-(640,79),0,bf
  352.   LOCATE 10,11:PRINT band$
  353.   IF band$="1.8" THEN b = 1
  354.   IF band$="3.5" THEN b = 2
  355.   IF band$="7.0" THEN b = 3
  356.   IF band$="14" THEN b = 4
  357.   IF band$="21" THEN b = 5
  358.   IF band$="28" THEN b = 6
  359.  
  360. fillzones: 
  361.   LOCATE 5,10:line.ptr=0
  362.   FOR y = 1 TO 40
  363.   line.ptr=line.ptr +1
  364.   IF line.ptr > 20 THEN LOCATE 7,10:line.ptr=1
  365.    PRINT bz$(b,y);" ";
  366.    NEXT y
  367.   RETURN
  368.  
  369. crossout: LOCATE 5,10:line.ptr=0:COLOR 3,0
  370.   FOR y = 1 TO 40
  371.   line.ptr=line.ptr +1
  372.   IF line.ptr > 20 THEN LOCATE 7,10:line.ptr=1
  373.    IF bz$(b,y) = nu.zone$ THEN bz$(b,y) = "  "
  374.    NEXT y
  375.    GOSUB fillzones
  376.    COLOR 1,0
  377.   RETURN
  378.  
  379.   
  380. prt.this.contact:LINE (63,72)-(640,79),0,bf
  381.   COLOR 3,0
  382.   LOCATE 10,11:PRINT band$ 
  383.   LOCATE 10,16:PRINT my.date$
  384.   LOCATE 10,26:PRINT my.time$
  385.   LOCATE 10,33:PRINT her.cal$
  386.   LOCATE 10,45:PRINT my.msg$
  387.   LOCATE 10,53:PRINT her.msg$
  388.   LOCATE 10,62:PRINT nu.zone$
  389.   LOCATE 10,67:PRINT mult$
  390.   LOCATE 10,76:PRINT pt$
  391.   RETURN
  392.  
  393. prt.this.contact1:LINE (63,72)-(640,79),0,bf
  394.   COLOR 3,0
  395.   LOCATE 10,11:PRINT band$ 
  396.   RETURN
  397.  
  398. 1000 'Code Generator
  399.   c$=CHR$(ASC(i$) OR 32)
  400.   IF c$="a" THEN b$=".-":GOTO 2000
  401.   IF c$="b" THEN b$="-...":GOTO 2000
  402.   IF c$="c" THEN b$="-.-.":GOTO 2000
  403.   IF c$="d" THEN b$="-..":GOTO 2000
  404.   IF c$="e" THEN b$=".":GOTO 2000
  405.   IF c$="f" THEN b$="..-.":GOTO 2000
  406.   IF c$="g" THEN b$="--.":GOTO 2000
  407.   IF c$="h" THEN b$="....":GOTO 2000
  408.   IF c$="i" THEN b$="..":GOTO 2000
  409.   IF c$="j" THEN b$=".---":GOTO 2000
  410.   IF c$="k" THEN b$="-.-":GOTO 2000
  411.   IF c$="l" THEN b$=".-..":GOTO 2000
  412.   IF c$="m" THEN b$="--":GOTO 2000
  413.   IF c$="n" THEN b$="-.":GOTO 2000
  414.   IF c$="o" THEN b$="---":GOTO 2000
  415.   IF c$="p" THEN b$=".--.":GOTO 2000
  416.   IF c$="q" THEN b$="--.-":GOTO 2000
  417.   IF c$="r" THEN b$=".-.":GOTO 2000
  418.   IF c$="s" THEN b$="...":GOTO 2000
  419.   IF c$="t" THEN b$="-":GOTO 2000
  420.   IF c$="u" THEN b$="..-":GOTO 2000
  421.   IF c$="v" THEN b$="...-":GOTO 2000
  422.   IF c$="w" THEN b$=".--":GOTO 2000
  423.   IF c$="x" THEN b$="-..-":GOTO 2000
  424.   IF c$="y" THEN b$="-.--":GOTO 2000
  425.   IF c$="z" THEN b$="--..":GOTO 2000
  426.   IF c$="1" THEN b$=".----":GOTO 2000
  427.   IF c$="2" THEN b$="..---":GOTO 2000
  428.   IF c$="3" THEN b$="...--":GOTO 2000
  429.   IF c$="4" THEN b$="....-":GOTO 2000
  430.   IF c$="5" THEN b$=".....":GOTO 2000
  431.   IF c$="6" THEN b$="-....":GOTO 2000
  432.   IF c$="7" THEN b$="--...":GOTO 2000
  433.   IF c$="8" THEN b$="---..":GOTO 2000
  434.   IF c$="9" THEN b$="----.":GOTO 2000
  435.   IF c$="0" THEN b$="-----":GOTO 2000
  436.   IF c$="." THEN b$=".-.-.-":GOTO 2000
  437.   IF c$="?" THEN b$="..--..":GOTO 2000
  438.   IF c$="," THEN b$="--..--":GOTO 2000
  439.   IF c$="-" THEN b$="-...-":GOTO 2000
  440.   IF c$="/" THEN b$="-..-.":GOTO 2000
  441.   IF i$=" " THEN b$=" ":GOTO 2000
  442.   IF i$=CHR$(8) THEN   'BACKSPACE FOR SENDING ERROR
  443.    b$="........"
  444.    LOCATE ,POS(0)
  445.    PRINT"";
  446.    GOTO 2000
  447.   END IF
  448.   IF i$=":" THEN b$="---...":GOTO 2000
  449.   IF i$=";" THEN b$="-.-.-.":GOTO 2000
  450.   IF i$="(" OR c$=")" THEN b$="-.--.-":GOTO 2000
  451.   IF i$="=" THEN b$="...-.-":GOTO 2000  'USE = FOR SK
  452.   IF i$="]" THEN b$=".-.-.":GOTO 2000   'USE ] FOR AR
  453.   IF i$="[" THEN b$="-...-.-":GOTO 2000 'USE [ FOR BK  
  454.   IF i$="\" THEN b$=".-...":GOTO 2000   'USE \ FOR AS
  455.   c$="" :b$="":i$=""
  456.  
  457. 2000 'SOUND ROUTINES
  458.  
  459. FOR E = 1 TO LEN(b$)
  460.   IF MID$(b$,E,1) ="." THEN
  461.     SOUND f,s!,200
  462.    ELSEIF MID$(b$,E,1)="-" THEN
  463.     SOUND f,s!*3,200
  464.   ELSE
  465.     SOUND f,s!*5,0
  466. END IF
  467.  
  468.   SOUND f,s!,0      'SPACE AFTER DOT OR DASH
  469. NEXT E               'GET THE NEXT DOT OR DASH IN THE CHAR
  470.  
  471.   SOUND f,s!*2.5,0    'SPACE AFTER CHAR
  472.   
  473. RETURN               'GET THE NEXT CHAR
  474.  
  475.  
  476. key29:
  477.   IF wpm < 6 THEN getout
  478.   wpm = wpm - 1
  479.   getout:
  480.   LOCATE 16,73:COLOR 2,6:PRINT USING "#####";wpm:COLOR 1,0
  481.   RETURN 
  482.  
  483. key28:
  484.   IF wpm > 59 THEN getout2
  485.   wpm = wpm + 1
  486.   getout2:
  487.   LOCATE 16,73:COLOR 2,6:PRINT USING "#####";wpm:COLOR 1,0 
  488.   RETURN
  489.   
  490. calc.speed:
  491.   IF wpm < 13 THEN cwpm=13 ELSE cwpm = wpm
  492.   s!=21.84/cwpm  'sets code element timing
  493.   IF wpm >= 13 THEN ELE=s! ELSE ELE = (43.68 -1.68 * wpm) / wpm
  494.   RETURN
  495.  
  496. full.fill:
  497.   OPEN "CQWW"+yr$+mode$ AS #2 LEN = 75
  498.   FIELD #2,3 AS bn$,8 AS dayt$,5 AS tyme$,12 AS his.ca$,6 AS my.nr$,6 AS his.nr$,2 AS nu.zo$,6 AS nu.mul$,1 AS poynt$,6 AS na$,5 AS time.prev$,5 AS time.on$,5 AS sign.in$,5 AS sign.out$
  499.   qso.ptr=0
  500.   
  501.   FOR b = 1 TO 6:RESTORE
  502.     FOR y = 1 TO 40
  503.        READ bz$(b,y)    
  504.      NEXT y
  505.      NEXT b 
  506.  
  507.   OPEN "bandzones"+yr$+mode$ AS #3 LEN=2
  508.   FIELD #3,2 AS zn$
  509.   zctr=0
  510.  
  511.   RETURN
  512.  
  513. sign.in:
  514.   LINE (0,80)-(399,87),0,bf
  515.   LOCATE 11,1:INPUT "Sign ON!:",sig$         'starts keeping track of
  516.   sig$=UCASE$(sig$)                          'operating time
  517.   IF sig$ <> "ON" AND sig$ <> "OFF" THEN sign.in
  518.   IF sig$="ON" THEN in.sign$ = LEFT$(TIME$,5)
  519.   qctr=0                                     'session qso counter
  520.   prev.time$ = in.sign$                      'establishes start time
  521.   RETURN
  522.  
  523. sign.out:
  524.   LINE (0,80)-(399,87),0,bf
  525.   LOCATE 11,1:INPUT "Sign OFF!:",sig$       
  526.   sig$=UCASE$(sig$)
  527.   IF sig$ <> "ON" AND sig$ <> "OFF" THEN sign.out
  528.   IF sig$="OFF" THEN out.sign$=LEFT$(TIME$,5)
  529.   IF qctr=0 THEN GOSUB no.qsos:GOSUB prt.header   
  530.   GOSUB calc.time                            'convert out.sign time to mins
  531.   GOSUB re.calc.time
  532.   temp.mins=on.time.mins:GOSUB convert.mins  'convert mins to hrs:mins
  533.   on.time$=hm$
  534.   dup.ptr = dup.ptr            
  535.   LSET sign.out$ = out.sign$          'brings time in last entry up to signoff
  536.   LSET time.on$ = on.time$            'for proper timekeeping
  537.   PUT #2, qso.ptr 
  538.     zctr=1
  539.   FOR b = 1 TO 6
  540.   FOR y = 1 TO 40
  541.   LSET zn$ = bz$(b,y)
  542.    PUT #3, zctr
  543.    zctr = zctr + 1
  544.    NEXT y
  545.    NEXT b
  546.   RETURN
  547.  
  548. no.qsos:
  549.   GOSUB calc.time
  550.   GOSUB re.calc.time
  551.   temp.mins=on.time.mins:GOSUB convert.mins
  552.   on.time$=hm$
  553.   qso.ptr = qso.ptr            
  554.   LSET time.on$ = on.time$     
  555.   PUT #2 , qso.ptr
  556.   RETURN
  557.   
  558. part.fill:
  559.   LOCATE 11,18:COLOR 5,0:PRINT "Be patient - building arrays":COLOR 1,0
  560.   OPEN "CQWW"+yr$+mode$ AS #2 LEN = 75
  561.   FIELD #2,3 AS bn$,8 AS dayt$,5 AS tyme$,12 AS his.ca$,6 AS my.nr$,6 AS his.nr$,2 AS nu.zo$,6 AS nu.mul$,1 AS poynt$,6 AS na$,5 AS time.prev$,5 AS time.on$,5 AS sign.in$,5 AS sign.out$
  562.   qso.ptr=LOF(2)/75
  563.   FOR i = 1 TO qso.ptr               'builds QSO array containing all info
  564.                                       'in the file
  565.   GET #2, i
  566.     q$(i,1) = bn$
  567.     IF q$(i,1)= "1.8" OR q$(i,1)="3.5" OR q$(i,1)="7.0" THEN GOTO jumpover1
  568.      ctr=INSTR(bn$," ")
  569.      q$(i,1)=LEFT$(bn$,ctr-1)
  570.     jumpover1:
  571.     q$(i,2) = dayt$
  572.     q$(i,3) = tyme$          
  573.     ctr = INSTR(his.ca$," ")         'Enter this contact into q$ array
  574.     q$(i,4) = LEFT$(his.ca$,ctr-1)   'with no trailing blanks
  575.     q$(i,5) = my.nr$     
  576.     q$(i,6) = his.nr$                               
  577.     q$(i,7) = nu.zo$
  578.     IF nu.zo$ = "  " THEN zctr%=0 ELSE zctr%=1  'counts zone multipliers 
  579.     ctr=INSTR(nu.mul$," ")
  580.     q$(i,8) = LEFT$(nu.mul$,ctr-1)
  581.     IF nu.mul$ = "      " THEN incr%=0 ELSE incr% = 1  'counts country multipliers 
  582.     q$(i,9) = poynt$
  583.     pts=VAL(poynt$)
  584.     ctr = INSTR(na$," ")
  585.     q$(i,10) = LEFT$(na$,ctr-1)
  586.     q$(i,11) = time.prev$
  587.     q$(i,12) = time.on$
  588.     q$(i,13) = sign.in$
  589.     q$(i,14) = sign.out$
  590.     temp$ = time.on$:GOSUB re.calc.time
  591.     time.prev$=sign.out$:GOSUB calc.time 
  592.     ctryctr = ctryctr + incr% 
  593.     zonectr = zonectr + zctr% 
  594.     ptsctr = ptsctr + pts                    
  595.     NEXT
  596.     tot! = ptsctr * (ctryctr+zonectr)     'using tot! gets around defint
  597.   
  598.   OPEN "bandzones"+yr$+mode$  AS #3 LEN=2   'builds band zone array of zones not worked
  599.   FIELD #3,2 AS zn$
  600.   zctr = 1
  601.   FOR b=1 TO 6
  602.   FOR x = 1 TO 40
  603.   GET #3, zctr
  604.   zctr= zctr + 1
  605.   bz$(b,x) = zn$
  606.     NEXT x
  607.     NEXT b
  608.    RETURN
  609.  
  610. prt.header:CLS
  611.   COLOR 5,0                               
  612.   LOCATE 2,5:PRINT "Continental US contacts valid for Zone multipliers only"
  613.   LOCATE 3,5:PRINT "Portable prefix precedes station call e.g. OH2/K6SG, CE0A/CE3AAA"
  614.   COLOR 1,0:LOCATE 4,32:PRINT "Zones NOT Worked"
  615.   LOCATE 9,1:PRINT "Prev. QSO Band Date      Time   Station     Sent    Recd    Zone  Ctry    Pts
  616.                                                                               
  617.   LINE (434,87)-(628,176),6,bf
  618.   COLOR 2,6                                                             
  619.   LOCATE 12,56:PRINT "Total Score"
  620.   LOCATE 12,70:PRINT USING "########";tot!
  621.   LOCATE 13,56:PRINT "Contest Mode "
  622.   LOCATE 14,56:PRINT "Oper. Time Used"
  623.   LOCATE 15,56:PRINT "Oper. Time Left"
  624.   LOCATE 16,56:PRINT "Words per Minute"
  625.   LOCATE 16,73:PRINT USING "#####";wpm
  626.   LOCATE 17,56:PRINT "QSO Rate"
  627.   LOCATE 19,56:PRINT "Free Mem."
  628.   LOCATE 19,70:PRINT FRE(-1)
  629.   LOCATE 21,56:PRINT "Total QSO's"
  630.   LOCATE 21,73:PRINT USING "#####";qso.ptr    
  631.   LOCATE 22,56:PRINT "Total Mult."
  632.   LOCATE 22,74:PRINT USING "####";ctryctr+zonectr
  633.   GOSUB calc.time
  634.   temp.mins = on.time.mins:GOSUB convert.mins
  635.   LOCATE 14,73:PRINT hm$                  
  636.   temp.mins = fortyeight.hrs - on.time.mins:GOSUB convert.mins
  637.   LOCATE 15,73:PRINT hm$  
  638.   temp.mins = 0                          'calc qso.rate 
  639.   IF on.time.mins = 0 THEN nix.div             '      " 
  640.   temp.mins = qso.ptr/((on.time.mins)/60)   '      "
  641.  
  642. nix.div:                                 
  643.   LOCATE 17,74:PRINT  USING "####";temp.mins
  644.   LOCATE 12,70:PRINT USING "########";tot!     'updates score
  645.   COLOR 1,0:           
  646.   
  647.   RETURN 
  648.  
  649. correct:COLOR 6,0:LINE (0,80)-(399,183),0,bf
  650.   LOCATE 12,5:PRINT "To SAVE this record press ENTER "  
  651.   LOCATE 14,5:PRINT "Press F7 to query His Number" 
  652.   LOCATE 16,5:PRINT "To DELETE this record press DELETE "   
  653.   COLOR 1,0:RETURN     
  654.  
  655.  
  656. convert.mins:               'Data comes to this routine as temp.mins
  657.   hrs = FIX(temp.mins/60)
  658.   a=temp.mins - (hrs * 60)
  659.   min=FIX(a)
  660.   hr$=STR$(hrs)
  661.   hr$=RIGHT$(hr$,2)
  662.   min$=STR$(min)
  663.   min$=RIGHT$(min$,2)
  664.   hm$=hr$ + ":" + min$
  665.   RETURN
  666.  
  667. put.routine:
  668.    GOSUB crossout
  669. by.pass:
  670.   GOSUB prt.this.contact
  671.   
  672.   COLOR 2,6 
  673.   qso.ptr = qso.ptr + 1     'Updates pointer to array & record numbers
  674.                              ' and counts qso's
  675.   LSET bn$ = band$ 
  676.   LSET dayt$ = my.date$
  677.   LSET tyme$ = my.time$
  678.   LSET his.ca$ = her.cal$ 
  679.   LSET my.nr$ = my.msg$
  680.   LSET his.nr$ = her.msg$
  681.   LSET nu.zo$ = nu.zone$
  682.   LSET nu.mul$ = mult$
  683.   LSET poynt$ = pt$
  684.   LSET na$ = thisctry$
  685.   LSET time.prev$ = prev.time$
  686.   LSET time.on$ = on.time$
  687.   LSET sign.in$ = in.sign$
  688.   LSET sign.out$ = out.sign$
  689.  
  690.    PUT #2, qso.ptr 
  691.   
  692.   GOSUB calc.time           
  693.   temp.mins = on.mins:GOSUB convert.mins
  694.   on.time$ = hm$ 
  695.  
  696.   in.sign$=" "
  697.   q$(qso.ptr,1) = band$             'puts last qso in qso array
  698.   q$(qso.ptr,2) = my.date$ 
  699.   q$(qso.ptr,3) = my.time$
  700.   q$(qso.ptr,4) = her.cal$
  701.   q$(qso.ptr,5) = my.msg$
  702.   q$(qso.ptr,6) = her.msg$
  703.   q$(qso.ptr,7) = nu.zone$ 
  704.   q$(qso.ptr,8) = mult$
  705.   q$(qso.ptr,9) = pt$ 
  706.   pts=VAL(pt$) 
  707.   q$(qso.ptr,10) = thisctry$
  708.   q$(qso.ptr,11) = prev.time$
  709.   q$(qso.ptr,12) = on.time$
  710.   q$(qso.ptr,13) = in.sign$
  711.   q$(qso.ptr,14) = out.sign$
  712.   
  713.   IF mult$ = "      " THEN incr%=0 ELSE incr%=1      'update counters
  714.   IF nu.zone$ = "  " THEN zctr%=0 ELSE zctr%=1
  715.   ctryctr = ctryctr + incr% 
  716.   zonectr = zonectr + zctr% 
  717.   ptsctr = ptsctr + pts                    
  718.   tot! = ptsctr * (ctryctr+zonectr)
  719.   LOCATE 12,70:PRINT USING "########";tot! 
  720.   GOSUB re.calc.time
  721.   temp.mins = on.time.mins:GOSUB convert.mins             'Calculate stats below   
  722.   LOCATE 14,73:PRINT hm$                                  '& print to screen 
  723.   temp.mins = fortyeight.hrs - on.time.mins:GOSUB convert.mins
  724.   LOCATE 15,73:PRINT hm$  
  725.   temp.mins = 0                         'calc qso.rate 
  726.   IF on.time.mins = 0 THEN no.div             '      " 
  727.   temp.mins = qso.ptr/((on.time.mins)/60)   '      "
  728.  
  729. no.div::GOSUB convert.mins              '      "
  730.   LOCATE 17,72:PRINT USING "######";temp.mins     'temp.mins = qso rate
  731.   LOCATE 19,70:PRINT FRE(-1)   
  732.   LOCATE 21,73:PRINT USING "#####";qso.ptr
  733.   LOCATE 22,74:PRINT USING "####";ctryctr+zonectr 
  734.   COLOR 1,0: time.prev$ = my.time$
  735.   GOTO  his.call.in
  736.  
  737. calc.time:
  738.   '*** Convert prev.time$ (hrs:min) to minutes ***   
  739.   hrs$ = LEFT$(prev.time$,2)         'Get the hours
  740.   hrs.mins = VAL(hrs$)*60           'Convert them to minutes
  741.   min$ = RIGHT$(prev.time$,2)        'Get the minutes
  742.   min = VAL(min$)                   'Convert them to value
  743.   prev.mins = hrs.mins + min         'Get minutes value for prev. contact
  744.  
  745.   '*** Convert my.time$ (hrs:min) to minutes ***  
  746.   hrs$ = LEFT$(my.time$,2)           'Get the hours
  747.   hrs.mins = VAL(hrs$)*60          'Convert them to minutes
  748.   min$ = RIGHT$(my.time$,2)          'Get the minutes
  749.   min = VAL(min$)                    'Convert them to value 
  750.   my.mins = hrs.mins + min           'Get minutes value for this contact
  751.  
  752.   '*** Convert out.sign$ (hrs:min) to minutes ***   
  753.   hrs$ = LEFT$(out.sign$,2)           'Get the hours
  754.   hrs.mins = VAL(hrs$)*60             'Convert them to minutes
  755.   min$ = RIGHT$(out.sign$,2)         'Get the minutes
  756.   min = VAL(min$)                    'Convert them to value
  757.   out.mins = hrs.mins + min          'Get minutes value for this contact
  758.  
  759.   '*** Compensate for clock passing 2400 hours ***
  760.   IF prev.mins > my.mins THEN my.mins = my.mins + 1440&
  761.   IF sig$ = "OFF" THEN on.mins=out.mins-prev.mins ELSE on.mins = my.mins - prev.mins
  762.   RETURN   
  763.  
  764. re.calc.time:
  765.   '*** Convert on.time$ (hrs:min) to minutes ***  
  766.   hrs$ = LEFT$(temp$,2)              'Get the hours
  767.   hrs.mins = VAL(hrs$)*60            'Convert them to minutes
  768.   min$ = RIGHT$(temp$,2)             'Get the minutes
  769.   min = VAL(min$)                    'Convert them to value
  770.   on.time.mins = hrs.mins + min
  771.   on.time.mins = on.time.mins + on.mins
  772.   RETURN
  773.  
  774. get.out:  
  775.   RETURN
  776.                                       
  777. wrap.today:
  778.   LINE (63,72)-(640,79),0,bf
  779.   CLOSE
  780.   CLS:CLEAR:CHAIN "CQWWDXBoot1.0"
  781.   END
  782.  
  783. zonelist:
  784.   DATA "01","02","03","04","05","06","07","08","09","10"
  785.   DATA "11","12","13","14","15","16","17","18","19","20"
  786.   DATA "21","22","23","24","25","26","27","28","29","30"
  787.   DATA "31","32","33","34","35","36","37","38","39","40"
  788.  
  789.   
  790.