5 ' PROGRAM NAME --   REGATA.BA       
6 ' Yacht Race Scoring Program    
7 '
8 '
99 ' INITIALIZE AND DIMENSION ARRAYS
100 DEFINTC:DEFINTD
110 CLEAR 3000
120 DIM FT$(30,6), CT(30,6), EM%(30), EH%(30), ES%(30), PT(30,6),A(30), PP(30), N$(30), PH(30),X(30), Y(30), BC(30,6)
129 ON ERROR GOTO 510
130 ZQ=30:GOSUB 4500:CLOSE
498 '
499 ' 
500 ' INITIAL MENU ROUTINE 
510 ZQ=C-1:CLS:PRINT"     YACHT RACE SCORING PROGRAM":PRINT
520 PRINT "This Program will score a Yacht Race "
530 PRINT "using either of the following systems:" 
540 PRINT "    1. Portsmouth "
550 PRINT "    2. PHRF (Performance Handicap)"
560 LINE INPUT"Type in the number of your choice: "; H$
598 ' 
599 ' 
700 ' MAIN MENU ROUTINE  
710 CLS:PRINT"You have the following options:"
712 PRINT"   1. Enter Race data"
720 PRINT"   2. Enter finish data"
730 PRINT"   3. Review existing information
740 PRINT"   4. Compute Race Results"
745 PRINT"   5. Compute Regatta results"
750 PRINT:LINE INPUT"Enter the number of your option: ";A$
755 CLS:IF A$="1" THEN GOSUB 800  :GOTO 700  
760 IF A$="2" THEN GOSUB 910: GOSUB 4000: GOTO 700
765 IF A$="3" THEN GOSUB 1050: GOTO 700
770 IF A$="5" THEN INPUT"How many races";NR:INPUT"How many throw-out races";TW:GOSUB 2500 :GOTO 700  
780 IF A$="4" THEN CLS:PRINT "You may compute a single race, ": PRINT "Or you may compute all races.":PRINT "     1. Compute one race only."
782 PRINT "     2. Compute all races.":LINE INPUT "Type in the number of your choice: ";B$
784 IF B$="1" THEN 786 ELSE IF B$="2" THEN 788 ELSE 780
786 INPUT"Which race";R:NR=R: GOSUB 1100: GOTO700
788 INPUT"How many races";NR: FOR R=1 TO NR:GOSUB 1100 :NEXT R:GOTO 700  
798 '
799 ' 
800   'RACE DATA INPUT ROUTINE  
810   CLS:PRINT"    PROCEDURE TO ENTER RACE DATA" 
820   PRINT"NOTE: All Time is Military Time" 
830   PRINT"      e.g. 2:05 P.M. = 14:05:00" 
840   INPUT"What Race are you Scoring";R
850   LINE INPUT "Enter Start Time (HH:MM:SS): ";ST$(R)
860   IF H$="2" THEN PRINT "FOR PHRF, Enter the Distance of": INPUT "the race in Nautical Miles....."; NM(R)
870 SH$=LEFT$(ST$(R),2): SM$= MID$ (ST$(R),4,2): SS$=RIGHT$(ST$(R),2)
880 SH%(R)=VAL(SH$): SM%(R)= VAL(SM$): SS%(R)=VAL(SS$)
890 RETURN
895 '
896 '
900 'FINISH TIME INPUT ROUTINE
910  CLS:PRINT "ENTER FINISH INFORMATION FOR EACH RACER"
920  PRINT"Enter <NONE> when finished"  
930  LINE INPUT"NAME (10 characters only): ";N$
940  IF N$="NONE" THEN GOTO 960  ELSE IF N$="None" THEN GOTO 960 
950 IF N$="none"THEN GOTO 960  ELSE IF N$=" "THEN GOTO 960  ELSE GOTO 970  
960 RETURN
970 INPUT"Racer Number: ";C: PRINT@138,"PHRF/Ports. #";: INPUT PH(C):IF C>ZQ THEN ZQ=C
980 INPUT"Race Number";R:PRINT@178,"Finish Time: ";:LINE INPUT FT$
990  PRINT:LINE INPUT"Is this correct? (Y)es/(N)o?: ";A$
1000  IF A$="Y" THEN GOTO 1010 
1002 IF A$="y" THEN GOTO 1010 
1004 GOTO 1020 
1010  N$(C)=N$: FT$(C,R)=FT$:C=C+1:GOTO 910   
1020  PRINT "We'll try again. Press any key"
1030  PRINT"when you are ready"
1040  A$=INKEY$:IF A$=""THEN 1040  ELSE 910   
1050 'REVIEW INFORMATION SUBROUTINE
1060  CLS:PRINT"Type in the number of the contestant": INPUT "that you wish to review: ";C
1070  CLS: PRINT "Racer #:";C;TAB(15)"Name: ";N$(C)
1080 PRINT "Handicap #:";PH(C);TAB(20);"Finish Times:":PRINTTAB(3);"Race #1: ";FT$(C,1);TAB(22);"Race #4: ";FT$(C,4):PRINTTAB(3);"Race #2: ";FT$(C,2);TAB(22);"Race #5: ";FT$(C,5)
1082 PRINTTAB(3);"Race #3: ";FT$(C,3);TAB(22);"Race #6: ";FT$(C,6)
1084 PRINT"To return to Menu, press M and enter;": LINE INPUT "To see another racer, press Enter: ";A$
1086 IF A$="M" THEN RETURN ELSE IF A$="m"THEN RETURN ELSE 1050
1099 ' 
1100 ' BEGINNING OF ACTUAL COMPUTATION 
1110 CLS:PRINT:PRINT "Computation Routine for: "
1120 FOR C=1 TO ZQ
1130 PRINT@121,"Race #";R:PRINT@161,"Contestant #";C
1140 CZ$="DSQ"
1150 DX=INSTR(FT$(C,R),CZ$)
1160 IF DX<>0 THEN GOSUB 1910 :GOTO 1330 
1170 BX$="DNF"
1180 AZ=INSTR(FT$(C,R),BX$)
1190 IF AZ<>0 THEN GOSUB 1910 :GOTO 1330 
1200 EY$="DNS"
1210 EY = INSTR(FT$(C,R),EY$)
1220 IF EY <> 0 THEN GOSUB 1920 :GOTO 1330 
1230 FH$=LEFT$(FT$(C,R),2): FM$=MID$(FT$(C,R),4,2): FS$= RIGHT$(FT$(C,R),2)
1240 FH%=VAL(FH$): FM%=VAL(FM$): FS%=VAL(FS$)
1250 EH%(C)=FH%-SH%(R):EM%(C)=FM%-SM%(R):ES%(C)=FS%-SS%(R)
1260 '
1270 '
1300 'GO TO COMPUTATION SUBROUTINE
1310 IF H$="2" THEN GOSUB 2210 :GOTO 1330 
1320 IF H$="1"THEN GOSUB 2310 :GOTO 1330 
1330 A(C)=CT(C,R)
1340 NEXT C
1350 '
1360 '
1400 'BUBBLE SORT ROUTINE   
1405 CLS:PRINT:PRINT:PRINT"SORTING -- RACER # "  
1410 FOR J=2 TO ZQ
1415 PRINT@170,J
1420 I=J-1:T=CT(J,R)
1425 IF I<=0 THEN 1450 
1430 IF T>=CT(I,R) THEN 1450 
1435 CT(I+1,R)=CT(I,R)
1440 I=I-1
1445 GOTO 1425 
1450 'END OF I LOOP
1455 CT(I+1,R) =T
1460 NEXT J
1465 '
1470 '
1500 ' TIE-HANDLING SUBROUTINE
1510 FOR C=1 TO ZQ
1520 IF CT(C,R)<>CT(C-1,R)THEN PP(C)=0:PP(C-1)=0:GOTO 1540 
1530 IF CT(C,R)=CT(C-1,R)THEN PP(C)=+.5:PP(C-1)=+.5
1540 NEXT C
1550 '
1560 '
1600 'TO ORDER THE NAMES WITH FINISH TIME
1605 I=1 
1610 CLS:PRINT"Pos";TAB(6);"Name";TAB(16)"Elap.Tm.";TAB(26) "Cor.Tm.";TAB(35)"Pts"
1615 FOR Z=I TO I+5 
1620 IF Z=ZQ+1 THEN 2410 
1625 FOR G=1 TO ZQ 
1630 IF CT(Z-1,R)=CT(Z,R) THEN GOTO 1780 
1635 IF CT(Z,R)<>A(G) THEN GOTO 1770 
1640 '   TO MOVE DNS,DSQ AND DNF OUT OF THE LOOP
1645 IF CT(Z,R)=99999THEN GOTO 1760 
1650 IF CT(Z,R)=99998 THEN GOTO 1760 
1655 ' 
1660 ' 
1700 'PRINTING RESULTS 
1710 PRINT Z;TAB(4);N$(G);TAB(16);:GOSUB 2010 ;: PRINTUSING "##:##:##";EH%(G);EM%(G);ES%(G);:PRINTTAB(25);: GOSUB 1810 ;
1720 FOR EY=1860 TO 0 STEP -60
1730 IF A(G) > EY THEN PRINTUSING"##:##.##"; EY/60;A(G)-EY; :PRINTTAB(34);PT(G,R): IF PT(G,R) = PT(G-1,R) THEN 1780  ELSE 1770
1740 NEXT EY 
1750 ' 
1760 PRINT Z;TAB(4);N$(G);TAB(21); FT$(G,R);TAB(34);PT(G,R)
1770 NEXT G
1780 NEXT Z
1785 GOSUB 3010 :I=I+6:GOTO 1610 
1790 '
1800 ' ROUTINE TO APPLY POINTS TO THE POSITIONS
1810  IF Z=1 THEN PT(G,R)=.75 + PP(Z): GOTO 1830 
1820 PT(G,R)=Z+PP(Z)
1830 RETURN
1840 '
1850 '
1900 '   SUBROUTINE TO TAKE OUT DNS, DSQ, DNF
1910 CT(C,R)=99998:GOSUB 2100: PT(C,R)=VZ+1:RETURN
1920 CT(C,R)=99999:L=ZQ: PT(C,R)=L+1:RETURN
1930 '
2000 '     ROUTINE TO CHANGE MINUTES AND SECONDS
2010 IF ES%(G)=>0 THEN 2040 
2020 ES%(G)=ES%(G)+60
2030 EM%(G)=EM%(G)-1
2040 IF EM%(G)=>0 THEN 2070 
2050 EM%(G)=EM%(G)+60
2060 EH%(G)=EH%(G)-1
2070 RETURN
2080 '
2085 ' 
2100 ' TO FIND NUMBER OF ACTUAL RACES FOR DSQ,DNF
2110 VZ=0:VV=0
2120 FOR CC=1 TO ZQ
2130 ZV$="DN":ZV=INSTR(FT$(CC,R),ZV$)
2140 IF ZV <> 0 THEN GOTO 2180 
2150 YV$="DS":YV=INSTR(FT$(CC,R),YV$)
2160 IF YV<>0 THEN GOTO 2180 
2170 VZ=VZ+1
2180 NEXT CC
2190 RETURN
2195 '
2200 ' COMPUTATION FORMULA FOR PHRF SCORING
2210 CT(C,R)=((((EH%(C)*60)+EM%(C))*60+ES%(C))- (NM(R)*PH(C)))/60
2220 RETURN
2230 '
2300 ' COMPUTATION FORMULA FOR PORTSMOUTH SCORING
2310 CT(C,R)=((((EH%(C)*60)+EM%(C)) *60+ES%(C))/(PH(C)/100))/60
2320 RETURN
2330 '
2340 '
2400 'End of Race Pause subroutine
2410 GOSUB 3010
2420 CLS:PRINT"To Print the Results again,"
2430 PRINT "               Type <Enter>."
2440 PRINT "To Continue the Program,"
2441 LINE INPUT"Type C(ontinue) And <Enter>: ";A$
2460 IF A$="C" THEN RETURN ELSE IF A$="c" THEN RETURN ELSE GOTO 1605 
2470 ' 
2480 '
2500 'SUBROUTINE COMPUTE TOTAL POINTS- ALL RACES
2510 CLS:PRINT:PRINT"Totals Now Being Computed"
2520 '
2530 ' Go to throw-out subroutine
2540 IF TW <>0 THEN GOSUB 2805 
2550 '
2560 '
2600 ' Begin Sort routine on points
2610 FOR C=1 TO ZQ
2615 X(C)=0
2620 FOR R=1 TO NR
2625 X(C)=X(C)+PT(C,R)
2630 NEXT R
2635 Y(C)=X(C)
2640 NEXT C
2645 FOR J=2 TO ZQ
2650 I =J-1:T=X(J)
2655 IF I<=0 THEN 2680 
2660 IF T>=X(I) THEN 2680 
2665 X(I+1)=X(I)
2670 I=I-1
2675 GOTO 2655 
2680 'END OF I LOOP
2685 X(I+1)=T
2690 NEXT J
2697 '
2698 '
2700 ' Beginning of print routine
2705 G=1 
2710 CLS:PRINT"Pos";TAB(5);"SKIPPER";TAB(22); "POINTS"
2715 FOR C=G TO G+2 
2720 IF C=ZQ+1 THEN GOSUB 3010 :GOTO 2785 
2725 FOR D=1 TO ZQ
2730 IF X(C-1)=X(C) THEN GOTO 2750 
2735 IF X(C)<>Y(D)THEN 2745 
2740 PRINTC;TAB(5);N$(D);TAB(22);X(C)
2742 PRINTTAB(4);PT(D,1); TAB(10);PT(D,2);TAB(16);PT(D,3);TAB(22); PT(D,4);TAB(28);PT(D,5); TAB(34);PT(D,6)
2745 NEXT D
2750 NEXT C
2755 '
2760 ' Display pause subroutine 
2765 GOSUB 3010 :G=G+3:GOTO2710 
2770 '
2775 ' 
2780 ' End of Printout Pause subroutine
2785 PRINT"Do you wish another print-out?": LINE INPUT"<Y>es or <N>o:";A$
2790 IF A$="Y" THEN GOTO 2705 ELSE IF A$="y" THEN GOTO 2705 ELSE RETURN 
2795 '
2798 '
2800 'BEGIN SUBROUTINE FOR THROW-OUT RACES
2805 CLS:PRINT" Throw-out race(s) being computed."
2810 FOR C=1 TO ZQ
2815 FOR D = 1 TO NR
2820 BC(C,D)=PT(C,D)
2825 NEXT D
2830 FOR J=2 TO NR
2835 I=J-1:T=BC(C,J)
2840 IF I<=0 THEN GOTO 2865 
2845 IF T>=BC(C,I) THEN GOTO 2865 
2850 BC(C,I+1)=BC(C,I)
2855 I=I-1
2860 GOTO 2840 
2865 'END OF I LOOP
2870 BC(C,I+1)=T
2875 NEXT J
2880 NEXT C
2885 '
2890 '
2900 'Loop to throwout highest scores
2910 RN=NR
2920 FOR C=1 TO ZQ
2930 FOR T=1 TO TW
2940 FOR D=1 TO NR
2950 IF BC(C,RN)=PT(C,D) THEN PT(C,D)=0:RN=RN-1:GOTO 2970 
2960 NEXT D
2970 NEXT T
2980 RN=NR
2990 NEXT C
2995 RETURN
2996 '
2997 '
3000 ' Pause Loop at end of display
3010 PRINT "Press any key to continue.";
3020 A$=INKEY$:IF A$=""THEN 3020 ELSE RETURN
4000 CLS:PRINT"Information is now being filed.":PRINT
4002 CLOSE:OPEN "RAM:RACER.DO" FOR OUTPUT AS 1
4010 FOR C=1 TO ZQ: PRINT #1,N$(C);","; PH(C);",";:FOR D=1 TO 6:PRINT #1, FT$(C,D);",";:NEXT D:NEXT C
4020 RETURN
4500 OPEN "RAM:RACER.DO" FOR INPUT AS 1
4510 FOR C=1 TO ZQ:INPUT #1, N$(C),PH(C), FT$(C,1),FT$(C,2),FT$(C,3), FT$(C,4), FT$(C,5), FT$(C,6):NEXT C
4520 RETURN