home *** CD-ROM | disk | FTP | other *** search
/ Amiga Elysian Archive / AmigaElysianArchive.iso / bus_pers / ham.lha / SSLog_v1.2 < prev    next >
Text File  |  1990-09-02  |  27KB  |  838 lines
  1. begin:
  2. CLEAR ,60000&
  3. 'Sept. 1990. SSLog-v1.2 was developed by George R. Leone, K6SG,
  4. 'and Walker L. Ayres, both of the Sacramento Amiga Computer Club. 
  5. 'This program may be freely copied and distributed for non-profit only.
  6. 'The developers assume no responsibility for any losses whatsoever incurred
  7. 'by its use nor do they assume any respopnsibility for its upkeep or debugging
  8. 'Use this public domain program at your own risk.
  9.  
  10.  
  11.   ans$="":b$="":band$="":bnd$="":c$="":contest.start$="":dayt$="":   
  12.   f$="":her.cal$="":her.chek$="":her.nr$="":her.prec$="":
  13.   her.sect$="":his.cal$="":his.chek$="":his.nr$="":his.prec$="":
  14.   his.sect$="":hm$="":hr$="":hrs$="":i$="":min$="":My$="":
  15.   my.call$="":my.check$="":my.date$="":my.nr$="":my.numb$="":
  16.   my.prec$="":my.sect$="":my.time$="":new.sect$="":nu.sect$="":   
  17.   poynt$="":prev.time$="":sayve$="":sect2$="":sw$="CM":temp$="": 
  18.   time.prev$="":time.on$="":two$="2":tyme$="":on.time$="":
  19.   a=0:array.ptr=0:col=0:ctr=0:ctr2=0:CWPM=0:E=0:ELE=0:f=0:
  20.   file.len=77:hrs=0:hrs.secs=0:i=0:line.ptr=0:loop=0:min=0:
  21.   min.sec=0:min.secs=0:my.div=0:my.place=0:my.row=0:my.secs=0:  
  22.   on.sec=0:ptr=0:prev.secs=0:qso.ptr=0:rec.ptr=0:   
  23.   row=0:sect.ctr=0:temp.secs=0:twentyfour.hrs=86400&:on.time.secs=0:
  24.  
  25.  
  26.   DIM sections$(77),changed.sections$(77),q$(2000),q2$(1,15)
  27.  
  28.   SCREEN 1,640,200,3,2
  29.   WINDOW 2,"                    ARRL SWEEPSTAKES CONTEST PROGRAM",(0,0)-(631,186),8,1
  30.   f = 800                      
  31.   wpm = 18                    
  32.   'Calculate speed, dot time
  33.   IF wpm < 13 THEN CWPM=13 ELSE CWPM =wpm
  34.   S=21.84/CWPM                
  35.   IF wpm >= 13 THEN ELE=S ELSE ELE = (43.68 -1.68 * wpm) / wpm 
  36.  
  37.  CLS:LOCATE 7,10:INPUT"Enter your Call Sign: ";my.call$
  38.   my.call$ = my.call$ + " ":my.call$ = UCASE$(my.call$)
  39.   LOCATE 9,10:INPUT"Precedence: ";my.prec$
  40.   my.prec$ = my.prec$ + " ":my.prec$ = UCASE$(my.prec$)
  41.   LOCATE 11,10:INPUT"Check: ";my.check$
  42.   my.check$ = my.check$ + " "
  43.   LOCATE 13,10:INPUT"Section: ";my.sect$
  44.   my.sect$ = my.sect$ + " ":my.sect$ = UCASE$(my.sect$)  
  45. git.year: 
  46.   LOCATE 15,10:INPUT"Enter last two digits of contest year:";yr$ 
  47.   IF yr$="" THEN GOTO git.year
  48. git.mode: 
  49.   LOCATE 17,10:INPUT"Enter mode - CW or SSB:";mo$
  50.   mo$=UCASE$(mo$)
  51.   IF mo$ <> "CW" AND mo$ <> "SSB" THEN GOTO git.mode
  52.   PALETTE 5,1,1,0
  53.   GOSUB fill.sec.array               
  54.   
  55.   OPEN "SECDAT"+yr$+mo$ AS #2 LEN = 4  
  56.   FIELD #2,3 AS sec2$,1 AS chk2$
  57.  
  58. get.ans:CLS
  59.   LOCATE 6,16
  60.   INPUT "Is this the beginning of the Contest Y/N ";ans$
  61.   ans$ = UCASE$(ans$)
  62.   IF ans$ <> "Y" AND ans$ <> "N" THEN get.ans
  63.   IF ans$ = "N" THEN GOSUB part.fill ELSE GOSUB full.fill 
  64.   GOSUB prt.header
  65.   GOSUB sign.in
  66.  
  67. band.in:
  68.   LINE (0,80)-(399,87),0,bf
  69.   LOCATE 11,1:INPUT "Enter Band  ";band$
  70.   IF band$ = "10" OR band$ = "15" OR band$ = "20" OR band$ = "40" OR band$ = "80" OR band$ = "160" THEN prt.this.contact1 
  71.   COLOR 5,0:LOCATE 12,3:PRINT band$;" is not a valid Band, please Re-Enter."
  72.   BEEP:BEEP::COLOR 1,0
  73.   GOTO band.in
  74.  
  75. his.call.in:LINE (0,80)-(399,183),0,bf 
  76. his.call.in2:My$ = "":her.cal$=""
  77.   new.sect$ = "X"
  78.   LOCATE 12,1:PRINT "Enter Call or Band (-1 to quit): ";     'her.cal$
  79.   row = 12:col = 34:GOSUB gk
  80.   her.cal$ = My$ 
  81.   IF her.cal$ = "" THEN LOCATE 13,5:PRINT "Get a Call or part of call!":GOTO his.call.in2
  82.   LOCATE 13,5:PRINT STRING$(27," ")
  83.   IF her.cal$ = "-1" THEN GOSUB sign.out:GOTO wrap.today
  84.   IF her.cal$ = "+" THEN GOSUB update.variable.sections:GOSUB refill.array:GOTO his.call.in
  85.   IF her.cal$ = "10" OR her.cal$ = "15" OR her.cal$ = "20" OR her.cal$ = "40" OR her.cal$ = "80" OR her.cal$ = "160" THEN band$ = her.cal$:GOTO prt.this.contact1
  86.   her.cal$ = UCASE$(her.cal$)
  87.   i = 0
  88.   dup.loop:i = i + 1  
  89.   IF i > qso.ptr THEN GOTO his.nr           'Call sign is not a duplicate
  90.   IF q$(i) = her.cal$ THEN GOSUB f6 ELSE GOTO dup.loop
  91.   LOCATE 13,3:COLOR 3,0:PRINT "***DUPE DUPE***.":COLOR 1,0
  92.   LINE (0,88)-(399,95),0,bf
  93.   GOTO his.call.in2
  94.   
  95. his.nr:My$ = "":LINE (0,96)-(399,103),0,bf                   
  96.   LOCATE 14,5:PRINT "Number: ";        'her.nr$   
  97.   row = 14:col = 20:GOSUB gk
  98.   her.nr$ = My$ 
  99.   
  100. his.prec:My$ = ""
  101.   LOCATE 16,5:PRINT "Precedence: ";      'her.prec$
  102.   row = 16:col = 20:GOSUB gk
  103.   her.prec$ = My$
  104.   her.prec$ = UCASE$(her.prec$)
  105.   LINE (0,128)-(430,135),0,bf
  106.  
  107. his.call.in3:My$ = "" 
  108.   LOCATE 17,5:COLOR 5:PRINT "Correct call or press RETURN: ";    'her.call$          'correct her.cal$
  109.   row = 17:col = 37:GOSUB gk
  110.   her.call$=My$
  111.   her.call$ = UCASE$(her.call$)
  112.   IF her.call$ <> "" AND her.call$ <> " " THEN her.cal$=My$
  113.   her.cal$=UCASE$(her.cal$):COLOR 1 
  114.   LINE (0,128)-(430,135),0,bf
  115.   i = 0
  116. dup.loop3:i = i + 1  
  117.   IF i > qso.ptr THEN GOTO his.check   
  118.   IF q$(i) = her.call$ THEN GOSUB f6 ELSE GOTO dup.loop3
  119.   LOCATE 13,3:COLOR 3,0:PRINT "***DUPE DUPE***.":COLOR 1,0
  120.   LINE (0,88)-(399,95),0,bf
  121.   GOTO his.call.in
  122.  
  123. his.check:My$ = ""
  124.   LOCATE 18,5:PRINT "Check: ";         'her.chek$
  125.   row = 18:col = 20:GOSUB gk
  126.   her.chek$ = My$
  127.  
  128. section.in:My$ = ""
  129.   LOCATE 20,5:PRINT "Section: ";       'her.sect$
  130.   row = 20:col = 20:GOSUB gk
  131.   her.sect$ = My$       
  132.   ctr = LEN(her.sect$)                         'make her.sect$  
  133.   IF ctr = 2 THEN her.sect$ = her.sect$ + " "  '3 characters long
  134.   her.sect$ = UCASE$(her.sect$)
  135.  
  136. loop1:                                 
  137.   My$ = "":LINE (0,152)-(399,159),0,bf 
  138.   my.date$ = LEFT$(DATE$,6)
  139.   my.date$ = my.date$ + RIGHT$(DATE$,2) 
  140.   my.time$ = LEFT$(TIME$,5)
  141.   my.numb$ = STR$(qso.ptr+1)
  142.   GOSUB prt.this.contact                            
  143.   GOSUB correct
  144.   GOSUB gk 
  145.   GOTO put.routine
  146.  
  147. gk:i$= INKEY$: IF i$="" THEN gk
  148.   i = ASC(i$)
  149.   IF i = 13 AND sw$ = "CM" THEN GOTO exit1
  150.   IF i = 28 THEN GOSUB key28:GOSUB calc.speed:GOTO gk
  151.   IF i = 29 THEN GOSUB key29:GOSUB calc.speed:GOTO gk
  152.   IF i = 33 AND sw$ = "CM" THEN GOSUB s1:GOTO gk     's1 his corrected call + r
  153.   IF i = 35 AND sw$ = "CM" THEN GOSUB s3:GOTO gk     's3 qrl?
  154.   IF i = 36 AND sw$ = "CM" THEN GOSUB s4:GOTO gk     's4 qrl pse qsy 
  155.   IF i = 37 AND sw$ = "CM" THEN GOSUB s5:GOTO gk     's5 ?
  156.   IF i = 38 AND sw$ = "CM" THEN GOSUB s7:GOTO gk     's7 mynr
  157.   IF i = 42 AND sw$ = "CM" THEN GOSUB s8:GOTO gk     's8 mypr
  158.   IF i = 40 AND sw$ = "CM" THEN GOSUB s9:GOTO gk     's9 myck
  159.   IF i = 41 AND sw$ = "CM" THEN GOSUB s0:GOTO gk     's0 mysec
  160.   IF i = 64 AND sw$ = "CM" THEN GOSUB s2:GOTO gk     's2 r + msg
  161.   IF i = 127 AND sw$ = "CM" THEN GOTO delet   
  162.   IF i = 129 AND sw$ = "CM" THEN GOSUB f1:GOTO gk      'F1 cq
  163.   IF i = 130 AND sw$ = "CM" THEN GOSUB f2:GOTO gk      'F2 msg
  164.   IF i = 131 AND sw$ = "CM" THEN GOSUB f3:GOTO gk      'F3 r + call
  165.   IF i = 132 AND sw$ = "CM" THEN GOSUB f4:GOTO gk      'F4 his call
  166.   IF i = 133 AND sw$ = "CM" THEN GOSUB f5:GOTO gk      'F5 my call
  167.   IF i = 134 AND sw$ = "CM" THEN GOSUB f6:GOTO gk      'F6 qso b4
  168.   IF i = 135 AND sw$ = "CM" THEN GOSUB f7:GOSUB ff7:GOSUB correct:GOTO gk   'F7 nr?
  169.   IF i = 136 AND sw$ = "CM" THEN GOSUB f8:GOSUB ff8:GOSUB correct:GOTO gk   'F8 prec?
  170.   IF i = 137 AND sw$ = "CM" THEN GOSUB f9:GOSUB ff9:GOSUB correct:GOTO gk   'F9 ck?
  171.   IF i = 138 AND sw$ = "CM" THEN GOSUB f10:GOSUB ff10:GOSUB correct:GOTO gk   'F10 sec?
  172.   
  173.   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 
  174.   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 
  175.  
  176.   IF sw$ = "CC" THEN GOSUB 1000:LOCATE 15,5:COLOR 1,2:My$ = My$ + i$:i$ = "":GOTO gk    'PRINT my$:                 
  177.   My$ = My$ + i$:i$ = ""
  178.   LOCATE row,col:PRINT My$:GOTO gk
  179.  
  180. exit1:RETURN
  181.  
  182.  
  183.  f1:LINE (0,168)-(279,175),0,bf:COLOR 1,0
  184.   f$ = "cq ss " + my.call$ + my.call$ + "ss"    
  185.   LOCATE 22,10:PRINT f$    
  186.   ctr2 = LEN(f$)
  187.   FOR loop = 1 TO ctr2
  188.   i$ = MID$(f$,loop,1)
  189.   GOSUB 1000
  190.   NEXT:RETURN   
  191.  
  192. f2:LINE (0,168)-(335,175),0,bf:COLOR 1,0    
  193.   f$ = her.cal$ + STR$(qso.ptr+1) + " " + my.prec$ + my.call$ + my.check$ + my.sect$ 
  194.   LOCATE 22,10:PRINT f$
  195.   ctr2 = LEN(f$)
  196.   FOR loop = 1 TO ctr2
  197.   i$ = MID$(f$,loop,1)
  198.   GOSUB 1000
  199.   NEXT:RETURN
  200.  
  201. f3:LINE (0,168)-(399,183),0,bf:COLOR 1,0
  202.   f$ = " r " + my.call$ + "ss"
  203.   LOCATE 22,10:PRINT f$
  204.   ctr2 = LEN(f$)
  205.   FOR loop = 1 TO ctr2
  206.   i$ = MID$(f$,loop,1)
  207.   GOSUB 1000
  208.   NEXT:RETURN     
  209.  
  210. f4:LINE (0,168)-(279,175),0,bf:COLOR 1,0
  211.   f$ = my.call$
  212.   LOCATE 22,10:PRINT f$
  213.   ctr2 = LEN(f$)
  214.   FOR loop = 1 TO ctr2
  215.   i$ = MID$(f$,loop,1)
  216.   GOSUB 1000
  217.   NEXT:RETURN  
  218.  
  219. f5:LINE (0,168)-(279,175),0,bf:COLOR 1,0
  220.   f$ = her.cal$
  221.   LOCATE 22,10:PRINT f$
  222.   ctr2 = LEN(f$)
  223.   FOR loop = 1 TO ctr2
  224.   i$ = MID$(f$,loop,1)
  225.   GOSUB 1000
  226.   NEXT:RETURN  
  227.  
  228. f6:       
  229.   f$ = her.cal$ + " qso b4 " + my.call$ + "ss"
  230.   ctr2 = LEN(f$)
  231.   FOR loop = 1 TO ctr2
  232.   i$ = MID$(f$,loop,1)
  233.   GOSUB 1000
  234.   NEXT:RETURN
  235.  
  236. f7:LINE (0,160)-(279,167),0,bf:COLOR 1,2
  237.   f$ =  "nr? "
  238.   ctr2 = LEN(f$)
  239.   FOR loop = 1 TO ctr2
  240.   i$ = MID$(f$,loop,1)
  241.   GOSUB 1000
  242.   NEXT:RETURN
  243.  
  244. f8:LINE (0,160)-(279,167),0,bf:COLOR 1,2
  245.   f$ =  "prec? "
  246.   ctr2 = LEN(f$)
  247.   FOR loop = 1 TO ctr2
  248.   i$ = MID$(f$,loop,1)               
  249.   GOSUB 1000
  250.   NEXT:RETURN   
  251.   
  252. f9:LINE (0,160)-(279,167),0,bf:COLOR 1,2
  253.   f$ =  "ck? "
  254.   ctr2 = LEN(f$)
  255.   FOR loop = 1 TO ctr2
  256.   i$ = MID$(f$,loop,1)          
  257.   GOSUB 1000
  258.   NEXT:RETURN  
  259.  
  260. f10:LINE (0,160)-(279,167),0,bf:COLOR 1,2
  261.   f$ =  "sec? "
  262.   ctr2 = LEN(f$)
  263.   FOR loop = 1 TO ctr2
  264.   i$ = MID$(f$,loop,1)
  265.   GOSUB 1000
  266.   NEXT:RETURN  
  267.  
  268. s1: 
  269.   f$ = her.cal$ + " r " + my.call$ + "ss"
  270.   ctr2 = LEN(f$)
  271.   FOR loop = 1 TO ctr2
  272.   i$ = MID$(f$,loop,1)
  273.   GOSUB 1000
  274.   NEXT:RETURN
  275.  
  276. s2:LINE (0,168)-(279,175),0,bf:COLOR 1,0   
  277.   f$ = "r nr" + STR$(qso.ptr+1) + " " + my.prec$ + my.call$ + my.check$ + my.sect$ 
  278.   LOCATE 22,10:PRINT f$
  279.   ctr2 = LEN(f$)
  280.   FOR loop = 1 TO ctr2
  281.   i$ = MID$(f$,loop,1)
  282.   GOSUB 1000
  283.   NEXT:RETURN   
  284.  
  285. s3:
  286.   f$ = "qrl? "+ my.call$
  287.   ctr2 = LEN(f$)
  288.   FOR loop = 1 TO ctr2
  289.   i$ = MID$(f$,loop,1)
  290.   GOSUB 1000
  291.   NEXT:RETURN
  292.  
  293. s4:
  294.   f$ = "qrl qsy "+ my.call$
  295.   ctr2 = LEN(f$)
  296.   FOR loop = 1 TO ctr2
  297.   i$ = MID$(f$,loop,1)
  298.   GOSUB 1000
  299.   NEXT:RETURN
  300.  
  301.  
  302. s5:
  303.   f$ = "?"
  304.   ctr2 = LEN(f$)
  305.   FOR loop = 1 TO ctr2
  306.   i$ = MID$(f$,loop,1)
  307.   GOSUB 1000
  308.   NEXT:RETURN
  309.  
  310. s7:
  311.   f$ = "nr " + STR$(qso.ptr +1) + " "
  312.   ctr2 = LEN(f$)
  313.   FOR loop = 1 TO ctr2
  314.   i$ = MID$(f$,loop,1)
  315.   GOSUB 1000
  316.   NEXT:RETURN
  317.  
  318. s8:
  319.     f$ = my.prec$ + " "
  320.   ctr2 = LEN(f$)
  321.   FOR loop = 1 TO ctr2
  322.   i$ = MID$(f$,loop,1)
  323.   GOSUB 1000
  324.   NEXT:RETURN
  325.  
  326.  
  327. s9:
  328.   f$ = my.check$
  329.   ctr2 = LEN(f$)
  330.   FOR loop = 1 TO ctr2
  331.   i$ = MID$(f$,loop,1)
  332.   GOSUB 1000
  333.   NEXT:RETURN
  334.  
  335. s0:
  336.   f$ = my.sect$
  337.   ctr2 = LEN(f$)
  338.   FOR loop = 1 TO ctr2
  339.   i$ = MID$(f$,loop,1)
  340.   GOSUB 1000
  341.   NEXT:RETURN
  342.  
  343.  
  344.  
  345. ff7:My$ = "":LINE (0,80)-(399,183),0,bf
  346.   LOCATE 15,5:PRINT "Enter His Number ";    'her.nr$
  347.   row = 15:col = 26:GOSUB gk
  348.   her.nr$ = My$:My$=""
  349.   LINE (63,72)-(640,79),0,bf
  350.   GOSUB prt.this.contact:LINE (0,80)-(399,183),0,bf
  351.   RETURN
  352.  
  353. ff8:My$ = "":LINE (0,80)-(399,183),0,bf
  354.   LOCATE 15,5:PRINT "Enter His Precedence ";       'her.prec$
  355.   row = 15:col = 26:sw = 8:GOSUB gk
  356.   her.prec$ = My$:My$=""
  357.   her.prec$ = UCASE$(her.prec$)
  358.   LINE (63,72)-(640,79),0,bf
  359.   GOSUB prt.this.contact:LINE (0,80)-(399,183),0,bf
  360.   RETURN
  361.  
  362. ff9:My$ = "":LINE (0,80)-(399,183),0,bf
  363.   LINE (0,120)-(399,127),0,bf 
  364.   LOCATE 15,5:PRINT "Enter His Check ";            'her.chek$
  365.   row = 15:col = 26:sw = 9:GOSUB gk
  366.   her.chek$ = My$:My$=""
  367.   LINE (63,72)-(640,79),0,bf
  368.   GOSUB prt.this.contact:LINE (0,80)-(399,183),0,bf
  369.   RETURN
  370.     
  371.  
  372. ff10:My$ = "" :LINE (0,80)-(399,183),0,bf
  373.   LOCATE 15,5:PRINT "Enter His Section ";        'her.sect$
  374.   row = 15:col = 26:sw = 10:GOSUB gk
  375.   her.sect$ = My$:My$=""       
  376.   ctr = LEN(her.sect$)                         ' makes her.sect$  
  377.   IF ctr = 2 THEN her.sect$ = her.sect$ + " "  '3 characters long
  378.   her.sect$ = UCASE$(her.sect$)
  379.   LINE (63,72)-(640,79),0,bf    
  380.   GOSUB prt.this.contact:LINE (0,80)-(399,183),0,bf
  381.   RETURN 
  382.  
  383. fill.sec.array:   
  384.   FOR i=1 TO 77
  385.   READ sections$(i)
  386.   NEXT
  387.   RETURN
  388.  
  389. delet:LINE (0,80)-(399,183),0,bf
  390.   LINE (63,72)-(640,79),0,bf
  391.   GOTO his.call.in
  392. prt.this.contact1:LINE (63,72)-(640,79),0,bf
  393.   COLOR 5,0
  394.   LOCATE 10,10:PRINT band$
  395.   COLOR 1,0
  396.   GOTO his.call.in
  397. prt.this.contact:LINE (63,72)-(640,79),0,bf
  398.   COLOR 5,0
  399.   LOCATE 10,10:PRINT band$
  400.   LOCATE 10,15:PRINT my.date$
  401.   LOCATE 10,25:PRINT my.time$
  402.   LOCATE 10,31:PRINT my.numb$
  403.   LOCATE 10,37:PRINT her.nr$
  404.   LOCATE 10,44:PRINT her.prec$       
  405.   LOCATE 10,48:PRINT her.cal$
  406.   LOCATE 10,61:PRINT her.chek$  
  407.   LOCATE 10,65:PRINT her.sect$
  408.   LOCATE 10,71:PRINT new.sect$
  409.   LOCATE 10,76:PRINT two$:COLOR 1,0
  410.   RETURN
  411.  
  412. 1000 'Code Generator
  413.   c$=CHR$(ASC(i$) OR 32)
  414.   IF c$="a" THEN b$=".-":GOTO 2000
  415.   IF c$="b" THEN b$="-...":GOTO 2000
  416.   IF c$="c" THEN b$="-.-.":GOTO 2000
  417.   IF c$="d" THEN b$="-..":GOTO 2000
  418.   IF c$="e" THEN b$=".":GOTO 2000
  419.   IF c$="f" THEN b$="..-.":GOTO 2000
  420.   IF c$="g" THEN b$="--.":GOTO 2000
  421.   IF c$="h" THEN b$="....":GOTO 2000
  422.   IF c$="i" THEN b$="..":GOTO 2000
  423.   IF c$="j" THEN b$=".---":GOTO 2000
  424.   IF c$="k" THEN b$="-.-":GOTO 2000
  425.   IF c$="l" THEN b$=".-..":GOTO 2000
  426.   IF c$="m" THEN b$="--":GOTO 2000
  427.   IF c$="n" THEN b$="-.":GOTO 2000
  428.   IF c$="o" THEN b$="---":GOTO 2000
  429.   IF c$="p" THEN b$=".--.":GOTO 2000
  430.   IF c$="q" THEN b$="--.-":GOTO 2000
  431.   IF c$="r" THEN b$=".-.":GOTO 2000
  432.   IF c$="s" THEN b$="...":GOTO 2000
  433.   IF c$="t" THEN b$="-":GOTO 2000
  434.   IF c$="u" THEN b$="..-":GOTO 2000
  435.   IF c$="v" THEN b$="...-":GOTO 2000
  436.   IF c$="w" THEN b$=".--":GOTO 2000
  437.   IF c$="x" THEN b$="-..-":GOTO 2000
  438.   IF c$="y" THEN b$="-.--":GOTO 2000
  439.   IF c$="z" THEN b$="--..":GOTO 2000
  440.   IF c$="1" THEN b$=".----":GOTO 2000
  441.   IF c$="2" THEN b$="..---":GOTO 2000
  442.   IF c$="3" THEN b$="...--":GOTO 2000
  443.   IF c$="4" THEN b$="....-":GOTO 2000
  444.   IF c$="5" THEN b$=".....":GOTO 2000
  445.   IF c$="6" THEN b$="-....":GOTO 2000
  446.   IF c$="7" THEN b$="--...":GOTO 2000
  447.   IF c$="8" THEN b$="---..":GOTO 2000
  448.   IF c$="9" THEN b$="----.":GOTO 2000
  449.   IF c$="0" THEN b$="-----":GOTO 2000
  450.   IF c$="." THEN b$=".-.-.-":GOTO 2000
  451.   IF c$="?" THEN b$="..--..":GOTO 2000
  452.   IF c$="," THEN b$="--..--":GOTO 2000
  453.   IF c$="-" THEN b$="-...-":GOTO 2000
  454.   IF c$="/" THEN b$="-..-.":GOTO 2000
  455.   IF i$=" " THEN b$=" ":GOTO 2000
  456.   IF i$=CHR$(8) THEN   'BACKSPACE FOR SENDING ERROR
  457.    b$="........"
  458.    LOCATE ,POS(0)
  459.    PRINT"";
  460.    GOTO 2000
  461.   END IF
  462.   IF i$=":" THEN b$="---...":GOTO 2000
  463.   IF i$=";" THEN b$="-.-.-.":GOTO 2000
  464.   IF i$="(" OR c$=")" THEN b$="-.--.-":GOTO 2000
  465.   IF i$="=" THEN b$="...-.-":GOTO 2000  'USE = FOR SK
  466.   IF i$="]" THEN b$=".-.-.":GOTO 2000   'USE ] FOR AR
  467.   IF i$="[" THEN b$="-...-.-":GOTO 2000 'USE [ FOR BK  
  468.   IF i$="\" THEN b$=".-...":GOTO 2000   'USE \ FOR AS
  469.   c$="" :b$="":i$=""
  470.  
  471. 2000 'SOUND ROUTINES
  472.   FOR E = 1 TO LEN(b$)
  473.     IF MID$(b$,E,1) ="." THEN
  474.       SOUND f,S,200
  475.     ELSEIF MID$(b$,E,1) ="-" THEN
  476.       SOUND f,S*3,200
  477.     ELSE
  478.       SOUND f,ELE*3,0   'SOUND F,ELE*3,0,0 = WORD SPACE
  479.   END IF
  480.  
  481.   SOUND f,ELE,0  'SPACE AFTER DOT OR DASH
  482.   NEXT E  'GET THE NEXT DOT OR DASH IN THE CHAR
  483.  
  484.   SOUND f,ELE*1.3,0     'SOUND F,ELE*3,0,0 = CHAR SPACE
  485.   RETURN  'GET THE NEXT CHAR
  486. END
  487.  
  488. key29:
  489.   IF wpm < 6 THEN getout
  490.   wpm = wpm - 1
  491.   getout:
  492.   LOCATE 16,73:COLOR 2,6:PRINT USING "#####";wpm:COLOR 1,0
  493.   RETURN 
  494.  
  495. key28:
  496.   IF wpm > 59 THEN getout2
  497.   wpm = wpm + 1
  498.   getout2:
  499.   LOCATE 16,73:COLOR 2,6:PRINT USING "#####";wpm:COLOR 1,0 
  500.   RETURN
  501.   
  502. calc.speed:
  503.   IF wpm < 13 THEN CWPM=13 ELSE CWPM = wpm
  504.   S=21.84/CWPM  'sets code element timing
  505.   IF wpm >= 13 THEN ELE=S ELSE ELE = (43.68 -1.68 * wpm) / wpm
  506. RETURN
  507.  
  508. full.fill:RESTORE
  509.   FOR i=1 TO file.len     'Fill changed.sections$ array with all Sections
  510.   READ changed.sections$(i)
  511.   NEXT
  512.   OPEN "SS"+yr$+mo$ AS #3 LEN = 63      
  513.   FIELD #3,11 AS his.cal$,8 AS dayt$,5 AS tyme$,4 AS his.nr$,1 AS his.prec$,2 AS his.chek$,3 AS bnd$,3 AS his.sect$,1 AS nu.sect$,4 AS my.nr$,1 AS poynt$,5 AS time.prev$,5 AS time.on$,5 AS sign.in$,5 AS sign.out$  
  514.   qso.ptr = 0:LOCATE 10,10
  515.   RETURN
  516.  
  517. sign.in:
  518.   LINE (0,80)-(399,87),0,bf
  519.   LOCATE 11,1:INPUT "Sign ON!:",sig$         'starts keeping track of
  520.   sig$=UCASE$(sig$)                          'operating time
  521.   IF sig$ <> "ON" AND sig$ <> "OFF" THEN sign.in
  522.   IF sig$="ON" THEN in.sign$ = LEFT$(TIME$,5)
  523.   qctr=0                                     'session qso counter
  524.   prev.time$ = in.sign$                      'establishes start time
  525.   RETURN
  526.  
  527. sign.out:
  528.   LINE (0,80)-(399,87),0,bf
  529.   LOCATE 11,1:INPUT "Sign OFF!:",sig$       
  530.   sig$=UCASE$(sig$)
  531.   IF sig$ <> "ON" AND sig$ <> "OFF" THEN sign.out
  532.   IF sig$="OFF" THEN out.sign$=LEFT$(TIME$,5)
  533.   IF qctr=0 THEN GOSUB no.qsos:GOSUB prt.header:GOTO wrap.today
  534.   GOSUB calc.time
  535.   GOSUB re.calc.time
  536.   temp.secs=on.time.secs:GOSUB convert.secs
  537.   on.time$=hm$
  538.   qso.ptr = qso.ptr            
  539.   LSET sign.out$ = out.sign$   
  540.   LSET time.on$ = on.time$    
  541.   PUT #3, qso.ptr              
  542.   RETURN
  543.  
  544. no.qsos:
  545.   GOSUB calc.time
  546.   GOSUB re.calc.time
  547.   temp.secs=on.time.secs:GOSUB convert.secs
  548.   on.time$=hm$
  549.   qso.ptr = qso.ptr            
  550.   LSET time.on$ = on.time$     
  551.   PUT #3, qso.ptr
  552.   RETURN
  553.   
  554. part.fill:
  555.  FOR i = 1 TO file.len
  556.  GET #2, i
  557.   changed.sections$(i) = sec2$
  558.   NEXT
  559.   OPEN "SS"+yr$+mo$ AS #3 LEN = 63     
  560.   FIELD #3,11 AS his.cal$,8 AS dayt$,5 AS tyme$,4 AS his.nr$,1 AS his.prec$,2 AS his.chek$,3 AS bnd$,3 AS his.sect$,1 AS nu.sect$,4 AS my.nr$,1 AS poynt$,5 AS time.prev$,5 AS time.on$,5 AS sign.in$,5 AS sign.out$  
  561.   qso.ptr = LOF(3)/63:LOCATE 10,10
  562.   FOR i=1 TO qso.ptr
  563.   GET #3,i                          'Get all previous contacts
  564.   ctr = INSTR(his.cal$," ")         'Enter this contact into q$ array
  565.   q$(i) = LEFT$(his.cal$,ctr-1)     'with no trailing blanks
  566.   ctr = INSTR(his.cal$," ")         'Enter this contact into q2$ array
  567.   q2$(1,1) = LEFT$(his.cal$,ctr-1)  'with no trailing blanks
  568.   q2$(1,2) = dayt$
  569.   q2$(1,3) = tyme$          
  570.   q2$(1,4) = his.nr$     
  571.   q2$(1,5) = his.prec$
  572.   q2$(1,6) = his.chek$
  573.   q2$(1,7) = bnd$
  574.   q2$(1,8) = his.sect$
  575.   q2$(1,9) = nu.sect$
  576.   IF nu.sect$ = "X" THEN sect.ctr = sect.ctr + 1  
  577.   q2$(1,10) = my.nr$                               
  578.   q2$(1,11) = poynt$
  579.   q2$(1,12) = time.prev$
  580.   q2$(1,13) = time.on$
  581.   q2$(1,14) = sign.in$
  582.   q2$(1,15) = sign.out$
  583.   temp$ = time.on$:GOSUB re.calc.time
  584.   time.prev$=sign.out$:GOSUB calc.time 
  585.   NEXT              
  586.   RETURN
  587.  
  588. prt.header:CLS 
  589.   LOCATE 1,5:COLOR 3,0:PRINT "WARNING: NEVER STOP THIS PROGRAM BY USING THE MOUSE!!! USE -1 INSTEAD.":COLOR 1  
  590.   LOCATE 2,1:line.ptr = 0
  591.   FOR i=1 TO file.len 
  592.   line.ptr = line.ptr + 1                'prints 15 sections per line 
  593.   IF line.ptr > 15  THEN PRINT:line.ptr = 1 
  594.   PRINT "  ";changed.sections$(i);
  595.   NEXT
  596.   LOCATE 8,1:PRINT STRING$(77,"-")
  597.   LOCATE 9,1:PRINT "Previous Band Date      Time   My#  His# Prec. Call-Sign   Chk. Sec. New  Pt."
  598.   LOCATE 10,1:PRINT "Contact"
  599.   GOSUB prev.stop  
  600.   LINE (434,87)-(628,176),6,bf
  601.   COLOR 2,6
  602.   LOCATE 12,56:PRINT "Score"
  603.   LOCATE 13,56:PRINT "Contest Mode "
  604.   LOCATE 14,56:PRINT "Oper. Time Used"
  605.   LOCATE 15,56:PRINT "Oper. Time Left"
  606.   LOCATE 16,56:PRINT "Words per Minute"
  607.   LOCATE 16,73:PRINT USING "#####";wpm
  608.   LOCATE 17,56:PRINT "QSO Rate"
  609.   LOCATE 19,56:PRINT "Free Mem."
  610.   LOCATE 19,70:PRINT FRE(-1)
  611.   LOCATE 21,56:PRINT "Contacts Made"
  612.   LOCATE 21,74:PRINT USING "####";qso.ptr    
  613.   LOCATE 22,56:PRINT "Sections Worked"
  614.   LOCATE 22,75:PRINT sect.ctr
  615.   GOSUB calc.time
  616.   temp.secs = on.time.secs:GOSUB convert.secs
  617.   LOCATE 14,73:PRINT hm$                  
  618.   temp.secs = twentyfour.hrs - on.time.secs:GOSUB convert.secs
  619.   LOCATE 15,73:PRINT hm$  
  620.   temp.secs = 0                          'calc qso.rate 
  621.   IF on.time.secs = 0 THEN nix.div             '      " 
  622.   temp.secs = qso.ptr/((on.time.secs)/3600)    '      "
  623.  
  624. nix.div:                                 
  625.   LOCATE 17,74:PRINT  USING "####";temp.secs
  626.   LOCATE 12,70:PRINT USING "#######";(qso.ptr * 2) * sect.ctr 'updates score
  627.   COLOR 1,0:           
  628.   RETURN 
  629.  
  630. reset.sections:LINE (0,8)-(615,55),0,bf
  631.   LOCATE 2,1  
  632.   line.ptr = 0                      
  633.   FOR i=1 TO file.len
  634.   line.ptr = line.ptr + 1 
  635.   IF line.ptr > 15  THEN PRINT:line.ptr = 1  
  636.   IF changed.sections$(i) = "   " THEN line.ptr = line.ptr -1:GOTO jump.a.line
  637.   PRINT "  ";changed.sections$(i);
  638. jump.a.line:NEXT
  639.   RETURN
  640.  
  641. correct:COLOR 6,0:LINE (0,80)-(399,183),0,bf
  642.   LOCATE 12,5:PRINT "To SAVE this record press ENTER Key"  
  643.   LOCATE 14,5:PRINT "Press F7 to query His Number" 
  644.   LOCATE 16,5:PRINT "Press F8 to query His Precedence"
  645.   LOCATE 18,5:PRINT "Press F9 to query His Check"
  646.   LOCATE 20,5:PRINT "Press F10 to query His Section"
  647.   LOCATE 22,5:PRINT "To DELETE this record press DELETE Key"   
  648.   COLOR 1,0:RETURN     
  649.  
  650. prev.stop:LINE (63,72)-(640,79),0,bf
  651.   COLOR 5,0                           
  652.   LOCATE 10,10:PRINT q2$(1,7)
  653.   LOCATE 10,15:PRINT q2$(1,2)  
  654.   LOCATE 10,25:PRINT q2$(1,3)
  655.   LOCATE 10,31:PRINT q2$(1,10)
  656.   LOCATE 10,37:PRINT q2$(1,4)     
  657.   LOCATE 10,44:PRINT q2$(1,5)
  658.   LOCATE 10,48:PRINT q2$(1,1)
  659.   LOCATE 10,61:PRINT q2$(1,6)      
  660.   LOCATE 10,65:PRINT q2$(1,8)
  661.   LOCATE 10,71:PRINT q2$(1,9)
  662.   LOCATE 10,76:PRINT q2$(1,11)
  663.   COLOR 1,0  
  664. RETURN
  665.  
  666. convert.secs:               'Data comes to this routine as temp.secs
  667.   hrs = FIX(temp.secs/3600)
  668.   a=temp.secs - (hrs * 3600)
  669.   min=FIX(a/60)
  670.   hr$=STR$(hrs)
  671.   hr$=RIGHT$(hr$,2)
  672.   min$=STR$(min)
  673.   min$=RIGHT$(min$,2)
  674.   hm$=hr$ + ":" + min$
  675.   RETURN
  676.  
  677. put.routine:
  678.   ptr = 0       
  679. loop2:
  680.   ptr=ptr+1:IF ptr > file.len THEN new.sect$ = " ":GOTO by.pass 'No X here
  681.   IF her.sect$ <> changed.sections$(ptr) THEN GOTO loop2
  682.   changed.sections$(ptr) = "   ":sect.ctr = sect.ctr + 1
  683.  
  684. by.pass:
  685.   GOSUB prt.this.contact
  686.   IF rl$ = "Y" THEN GOSUB hardcopy
  687.   COLOR 2,6 
  688.   qso.ptr = qso.ptr + 1     'Update pointer to array & record numbers
  689.   qctr = qctr + 1           'counts qso's this session
  690.   GOSUB calc.time 
  691.   temp.secs = on.secs:GOSUB convert.secs
  692.   on.time$ = hm$ 
  693.   LSET his.cal$ = her.cal$  
  694.   LSET dayt$ = my.date$
  695.   LSET tyme$ = my.time$
  696.   LSET his.nr$ = her.nr$
  697.   LSET his.prec$ = her.prec$
  698.   LSET his.chek$ = her.chek$
  699.   LSET bnd$ = band$
  700.   LSET his.sect$ = her.sect$
  701.   LSET nu.sect$ = new.sect$
  702.   LSET my.nr$ = my.numb$
  703.   LSET poynt$ = two$
  704.   LSET time.prev$ = prev.time$
  705.   LSET time.on$ = on.time$
  706.   LSET sign.in$ = in.sign$
  707.   LSET sign.out$ = out.sign$
  708.   PUT #3, qso.ptr                 
  709.   in.sign$=" "
  710.   q$(qso.ptr) = her.cal$          'Enter his call sign into q$ array
  711.   LOCATE 12,70:PRINT USING "#######";(qso.ptr * 2) * sect.ctr 
  712.   GOSUB re.calc.time
  713.   temp.secs = on.time.secs:GOSUB convert.secs             'Calculate stats below   
  714.   LOCATE 14,73:PRINT hm$                                  '& print to screen 
  715.   temp.secs = twentyfour.hrs - on.time.secs:GOSUB convert.secs
  716.   LOCATE 15,73:PRINT hm$  
  717.   temp.secs = 0                                   'calc qso.rate 
  718.   IF on.time.secs = 0 THEN no.div                 '      " 
  719.   temp.secs = qso.ptr/((on.time.secs)/3600)       '      "
  720.  
  721. no.div: GOSUB convert.secs             
  722.   LOCATE 17,72:PRINT USING "######";temp.secs     'temp.secs = qso rate
  723.   LOCATE 19,70:PRINT FRE(-1)   
  724.   LOCATE 21,70:PRINT USING "########";qso.ptr
  725.   LOCATE 22,75 :PRINT sect.ctr 
  726.   COLOR 1,0: time.prev$ = my.time$
  727.   GOSUB blank.sect
  728.   GOTO  his.call.in 
  729.  
  730. calc.time:
  731.   '*** Convert prev.time$ (hrs:min) to seconds ***
  732.   hrs$ = LEFT$(prev.time$,2)         'Get the hours
  733.   hrs.secs = VAL(hrs$)*3600          'Convert them to seconds
  734.   min$ = RIGHT$(prev.time$,2)        'Get the minutes
  735.   min.secs = VAL(min$)*60            'Convert them to seconds
  736.   prev.secs = hrs.secs + min.secs    'Get seconds value for prev. contact
  737.   
  738.   '*** Convert my.time$ (hrs:min) to seconds ***  
  739.   hrs$ = LEFT$(my.time$,2)           'Get the hours
  740.   hrs.secs = VAL(hrs$)*3600          'Convert them to seconds
  741.   min$ = RIGHT$(my.time$,2)          'Get the minutes
  742.   min.secs = VAL(min$)*60            'Convert them to seconds
  743.   my.secs = hrs.secs + min.secs      'Get seconds value for this contact
  744.   
  745.   '*** Convert out.sign$ (hrs:min) to seconds ***  
  746.   hrs$ = LEFT$(out.sign$,2)           'Get the hours
  747.   hrs.secs = VAL(hrs$)*3600          'Convert them to seconds
  748.   min$ = RIGHT$(out.sign$,2)          'Get the minutes
  749.   min.secs = VAL(min$)*60            'Convert them to seconds
  750.   out.secs = hrs.secs + min.secs      'Get seconds value for this contact
  751.  
  752.   '*** Compensate for clock passing 2400 hours ***
  753.   IF prev.secs > my.secs THEN my.secs = my.secs +86400&
  754.   IF sig$ = "OFF" THEN on.secs=out.secs-prev.secs ELSE on.secs = my.secs - prev.secs
  755.   RETURN   
  756.  
  757. re.calc.time:
  758.   '*** Convert on.time$ (hrs:min) to seconds ***
  759.   hrs$ = LEFT$(temp$,2)              'Get the hours
  760.   hrs.secs = VAL(hrs$)*3600          'Convert them to seconds
  761.   min$ = RIGHT$(temp$,2)             'Get the minutes
  762.   min.secs = VAL(min$)*60            'Convert them to seconds
  763.   on.time.secs = hrs.secs + min.secs       
  764.   on.time.secs = on.time.secs + on.secs
  765.   RETURN
  766.  
  767. refill.array:           'Fill changed.sections$ array with unused Sections
  768.   FOR i=1 TO file.len   'only when continuing contest
  769.   GET #2, i
  770.   changed.sections$(i) = sec2$
  771.   NEXT
  772.   RETURN
  773.  
  774. update.variable.sections:  'Make var.dat.sec file hold only unused sections  
  775.   FOR i=1 TO file.len      'Set variable section file to blanks
  776.   LSET sec2$ = "   "       'temporarily
  777.   PUT #2,i
  778.   NEXT
  779.   array.ptr = 1            'Reset pointers to array
  780.   rec.ptr = 1              'and record
  781.  
  782. check.rec:   'Replace variable section file with UNUSED sections
  783.   IF changed.sections$(array.ptr) = "   " THEN up.array.ptr 'array = blank
  784.   LSET sec2$ = changed.sections$(array.ptr)  'LSET unused section
  785.   PUT #2, rec.ptr                            'and write it to file
  786.   rec.ptr = rec.ptr + 1:IF rec.ptr > file.len THEN get.out
  787.  
  788. up.array.ptr:
  789.   array.ptr = array.ptr + 1:IF array.ptr > file.len THEN get.out
  790.   IF rec.ptr < file.len + 1 THEN check.rec 
  791.  
  792. get.out:  'File now has all Unused Sections at beginning of file 
  793.   GOSUB reset.sections  
  794.   RETURN
  795.  
  796. select: 
  797.   CLS:LOCATE 7,10:PRINT"MAIN MENU"
  798.   LOCATE 9,15:PRINT"(1) Log Contacts"
  799.   LOCATE 11,15:PRINT"(2) Print Reports"
  800.   LOCATE 13,15:PRINT"(3) View Reports on Screen"
  801.   LOCATE 15,15:PRINT"(4) Quit"
  802.   LOCATE 17,10:INPUT "Select a number "; sel$
  803.   IF sel$ <> "1" AND sel$ <> "2" AND sel$ <> "3" AND sel$ <> "4" THEN select
  804.   IF sel$="1" THEN CLS:CLEAR:GOTO begin
  805.   IF sel$="2" THEN CLS:CLEAR:CHAIN "SSPRT_v1.2"
  806.   IF sel$="3" THEN CLS:CLEAR:CHAIN "SSScrn_v1.2"
  807.   IF sel$="4" THEN GOTO halt
  808.  
  809. wrap.today:   
  810.   GOSUB update.variable.sections
  811.   CLOSE
  812.   GOTO select
  813.  
  814. blank.sect:   'Blank section on screen when you use the section
  815.   my.div = ptr + 29                     'my.div now contains ptr + 14    
  816.   my.row = FIX(my.div / 15)             'my.row now contains window row   
  817.   my.place = my.div - (my.row * 15) + 1 'my.place = placement # 
  818.   my.place = (my.place * 5) - 2         'my.place = row location to blank 5   
  819.   LOCATE my.row,my.place:PRINT "   "
  820.   RETURN
  821.  
  822. halt:
  823.   CLOSE:CLS
  824.   LOCATE 10,1:PRINT TAB(30); "THAT'S ALL!"
  825.   END
  826.         
  827. Section.names:       '77 Sections
  828.     
  829.   DATA "AB ","AK ","AL ","AR ","AZ ","BC ","CO ","CT ","DE ","EB "
  830.   DATA "EMA","ENY","EPA","EWA","GA ","IA ","ID ","IL ","IN ","KS " 
  831.   DATA "KY ","LA ","LAX","MAR","MB ","MDC","ME ","MI ","MN ","MO "  
  832.   DATA "MS ","MT ","NC ","ND ","NE ","NFL","NH ","NLI","NM ","NNJ" 
  833.   DATA "NTX","NV ","OH ","OK ","ON ","OR ","ORG","PAC","PR ","QUE" 
  834.   DATA "RI ","SB ","SC ","SCV","SD ","SDG","SF ","SFL","SJV","SK " 
  835.   DATA "SNJ","STX","SV ","TN ","UT ","VA ","VI ","VT ","WI ","WMA"
  836.   DATA "WNY","WPA","WTX","WV ","WWA","WY ","YNT"
  837.  
  838.