10000 '*************************************************************
10010 '*****    PC-GOLF    THE GOLFER's PROGRAM     PC-GOLF    *****
10020 '*****    Version 1.3  (C) 1982,1983,1984 Ed Chandler    *****
10030 '*************************************************************
10040 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
10050 '     3. GET THE GOLFERS ROSTER
10060 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
10070 CLS:PRINT MNU3$:PRINT
10072 IF ROS=0 THEN 10080
10075 DEF SEG=&H40:I%=PEEK(&H17):I%=I% OR 32:POKE &H17,I% 'num lock on
10080 MNU1$="1.  REVIEW the golfer's roster.":PRINT SPC(3);MNU1$
10090 MNU2$="2.  ADD a new player to the roster.":PRINT SPC(3);MNU2$
10100 MNU4$="3.  CHANGE the golfer's roster.":PRINT SPC(3);MNU4$
10110 MNU5$="4.  DELETE a player from the roster.":PRINT SPC(3);MNU5$
10120 MNU6$="5.  ERASE a player's score sheet.":PRINT SPC(3)MNU6$
10130 PRINT SPC(3);MNURT$:PRINT
10140 M1$="key":M2$="(1,2,3,4,5 OR M). ":GOSUB 570
10150 IF KB=1 THEN 10250 'review
10160 IF KB=2 THEN 10320 'add
10170 IF KB=3 THEN 11080 'update
10180 IF KB=4 THEN 12030 'delete
10190 IF KB=5 THEN 12270 'erase scores
10200 IF KB$="M" OR KB$="m" THEN 530 'back to main
10210 GOSUB 610:GOTO 10070
10220 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
10230 '     3.1. Review Player Roster
10240 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
10250 GOSUB 10260:GOTO 10070 'return
10260 CLS:PRINT MNU1$:X=1:GOSUB 550 'display player roster
10270 IF PR=0 THEN GOSUB 580 ELSE GOSUB 590
10280 RETURN
10290 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
10300 '     3.2. ADD a Player to the Roster
10310 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
10320 GOSUB 10330:GOTO 10070 'return
10330 CLS:PRINT MNU2$:IF CACT>0 THEN 10360
10340 PRINT:PRINT"To add a player to the roster you must first"
10350 PRINT"add his home course to the course directory.":GOSUB 580:RETURN
10360 IF PACT<PMAX THEN 10400 'tra if room for one more
10370 PRINT:PRINT "The Player Roster is full.":PRINT
10380 PRINT "To add a player you must first"
10390 PRINT "delete a player from the roster.":GOSUB 580:RETURN
10400 RESTORE 815:GOSUB 600
10410 IF KB$<>"Y" THEN RETURN
10420 CLS:PRINT MNU2$:PRINT:PRINT"Are you adding a man or woman golfer?"
10430 PRINT:PRINT" 1.  Man":PRINT" 2.  Woman"
10440 PRINT:LINE INPUT"ENTER the correct line number. ";KB$
10450 KB=VAL(KB$):IF KB<1 OR KB>2 THEN GOSUB 610:GOTO 10420
10460 IF KB=1 THEN T1$=MSEX$ ELSE T1$=FSEX$
10470 CLS:PRINT MNU2$:PRINT
10480 LINE INPUT "ENTER the name of the player you're adding. ";KB$
10490 L=LEN(KB$):IF L>0 AND L<=NMAX THEN 10530
10500 PRINT:PRINT"Please limit the name to ";NMAX;" letters maximum."
10510 GOSUB 580:GOTO 10470
10520 '+++++     find PLAYER ID # for the addition
10530 GOSUB 700:GOSUB 660 'open PDIR,DAT
10540 FOR I=1 TO PMAX:GET #4,I:RN=CVI(A4$) 'ID #
10550 IF RN=0 THEN RN=I:GOTO 10610 'USE THIS SLOT FOR PLAYER ID
10560 NEXT:IF RN<PMAX THEN 10610 'TRA IF ROOM FOR ONE MORE
10570 PRINT:PRINT "The Player Roster is full.":PRINT
10580 PRINT "To add a player you must first":PRINT "delete one from the roster."
10590 CLOSE #4:GOSUB 580:RETURN
10600 '+++++     store ID # and name
10610 RSET A4$=MKI$(RN):LSET B4$=KB$:RSET F4$=T1$ 'ID, name, sex
10620 CLS:PRINT MNU2$:PRINT
10630 LINE INPUT"ENTER the players phone number, e.g. 555-1212 . ";KB$
10640 L=LEN(KB$):IF L=8 THEN 10670
10650 PRINT:PRINT"Please limit the phone number to 8 characters."
10660 GOSUB 580:GOTO 10620
10670 RSET C4$=KB$ 'phone #
10680 '+++++     handicap     +++++
10690 CLS:PRINT MNU2$:PRINT
10700 LINE INPUT"ENTER the players handicap. ",KB$
10710 GOSUB 11650:IF X=-1 THEN 10690
10720 RSET D4$=KB$+"*" 'h'cap
10730 '+++++     get players home course ID     +++++
10740 CLS:PRINT MNU2$:M1=0:GOSUB 540 'display course list
10750 PRINT:LINE INPUT"ENTER the line number of the players home course. ";KB$
10760 KB=VAL(KB$):IF KB>0 AND KB<= CMAX AND TMP(KB)=KB THEN 10790 'entry ok
10770 PRINT:PRINT "Please choose a line number from the list."
10780 GOSUB 580:GOTO 10740
10790 RSET E4$=KB$ 'course id#
10800 '+++++     customary tee box     +++++
10810 CLS:PRINT MNU2$:PRINT
10820 GOSUB 10840:GOTO 10970
10830 '+++++
10840 GOSUB 655:GET #3,KB:CLOSE #3 'get course
10850 PRINT"Which tee will this player normally use?":PRINT:T=1
10860 IF CVS(K2$)<>0 THEN PRINT USING"   #.  GOLD";T:T$(T)="g":T=T+1
10870 IF CVS(L2$)<>0 THEN PRINT USING"   #.  BLUE";T:T$(T)="b":T=T+1
10880 IF CVS(F2$)<>0 THEN PRINT USING"   #.  WHITE";T:T$(T)="w":T=T+1
10890 IF CVS(I2$)<>0 THEN PRINT USING"   #.  RED";T:T$(T)="r":T=T+1
10900 PRINT:LINE INPUT"ENTER the line number of the player's usual tee. ";KB$
10910 KB=VAL(KB$):IF KB>0 AND KB<T THEN 10940
10920 PRINT:PRINT"Please choose a line number from the list."
10930 GOSUB 580:CLS:GOTO 10850
10940 RSET G4$=T$(KB) 'normal tee box
10950 RETURN
10960 '+++++     WRITE PLAYER DIRECTORY FILE PDIR.DAT     +++++
10970 PUT #4,RN:CLOSE #4
10980 '+++++     UPDATE PACT. REWRITE INIT.DAT FILE     +++++
10990 X=1:GOSUB 630 'UPDATE PACT-INIT.DAT FILE
11000 '+++++     INITIALIZE PLAYER.DAT FILE     +++++
11010 GOSUB 670:GOSUB 672:RSET B5$=E4$:RSET C5$=D4$ ' inits
11020 PUT #5,RN:CLOSE #5
11030 CLS:PRINT "Addition completed for ";B4$:X=1:GOSUB 550 'show roster
11040 GOSUB 580:RETURN
11050 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
11060 '     3.3. UPDATE the Player Roster   PDIR.DAT
11070 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
11080 GOSUB 11090:GOTO 10070 'return
11090 CLS:PRINT MNU4$
11100 '
11110 RESTORE 816:GOSUB 600
11120 IF KB$<>"Y" THEN RETURN
11130 CLS:PRINT MNU4$:X=1:GOSUB 550 'show roster
11140 IF PR=0 THEN GOSUB 580:RETURN 'empty roster
11150 PRINT:LINE INPUT"ENTER the line number of the player you want to change. ";KB$
11160 KB=VAL(KB$):IF KB>0 AND KB<=PMAX AND TMP(KB)=KB THEN RN=KB:GOTO 11200
11170 '
11180 GOSUB 611:GOTO 11130
11190 '+++++     change a field     +++++
11200 GOSUB 660:GET #4,RN 'get record to be changed
11210 GOSUB 670:GET #5,RN 'player.dat
11220 KB$=B4$:GOSUB 700:PN$=KB$ 'player name
11230 CLS:PRINT MNU4$:PRINT
11240 PRINT "LINE #"
11250 PRINT " 1. Player's Name";SPC(5);B4$
11260 PRINT " 2. Telephone    ";SPC(5);C4$
11270 PRINT " 3. Handicap     ";SPC(5);D4$
11280 N=VAL(E4$):T$=MID$(GCDIR$(N),3,NMAX)
11290 PRINT " 4. Home Course  ";SPC(5);T$:KB$=T$:GOSUB 700:CN$=KB$ 'name
11300 T$="Gold":IF G4$="b" THEN T$="Blue"
11310 IF G4$="w" THEN T$="White" ELSE IF G4$="r" THEN T$="Red"
11320 PRINT " 5. Usual tee box";SPC(5)T$
11330 PRINT:LINE INPUT"ENTER the number of the line you want to change. ";KB$
11340 KB=VAL(KB$):IF KB>0 AND KB<=5 THEN 11390
11350 PRINT:PRINT "Please choose a line number from the list."
11360 GOSUB 580:GOTO 11230
11370 '
11380 '
11390 KB$=INKEY$:IF KB$<>"" THEN 11390
11400 '+++++     player name     +++++
11410 IF KB<>1 THEN 11480
11420 CLS:PRINT MNU4$
11430 PRINT:LINE INPUT"ENTER the replacement name. ";KB$
11440 IF LEN(KB$)>0 AND LEN(KB$)<=NMAX THEN GOSUB 700:LSET B4$=KB$:GOTO 11980
11450 PRINT:PRINT"The name is too long. ";NMAX;" letters maximum. Try again."
11460 GOSUB 580:GOTO 11420
11470 '+++++     phone #     +++++
11480 IF KB<>2 THEN 11560
11490 CLS:PRINT MNU4$
11500 PRINT:LINE INPUT"ENTER the replacement phone number. ";KB$
11510 L=LEN(KB$):IF L=8 THEN 11540
11520 PRINT:PRINT"Please limit the phone number to 8 characters."
11530 GOSUB 580:GOTO 11410
11540 RSET C4$=KB$:GOTO 11980 'phone #
11550 '+++++     handicap     +++++
11560 IF KB<>3 THEN 11770
11570 T$=RIGHT$(C5$,1):IF T$<>"T" AND T$<>" " THEN 11610 'no hcap yet
11580 PRINT:PRINT"A handicap of ";C5$;" has been established for ";PN$;"."
11590 PRINT:PRINT"You cannot change an established handicap."
11600 GOSUB 580:GOTO 11980
11610 CLS:PRINT MNU4$
11620 PRINT:LINE INPUT"ENTER the replacement handicap. ";KB$
11630 GOSUB 11650:IF X=0 THEN 11750 ELSE 11610
11640 '+++++
11650 X=0:T$=LEFT$(KB$,1):L=LEN(KB$):IF L<1 OR L>2 THEN 11700
11660 N=VAL(LEFT$(KB$,2)):IF T$="+" THEN N=VAL(MID$(KB$,2,1))
11670 KB$=LEFT$(KB$,2):IF N<0 OR N>40 THEN 11700
11680 IF T$="-" THEN 11700
11690 IF F4$=MSEX$ AND N<=36 OR F4$=FSEX$ THEN RETURN
11700 PRINT:PRINT"Handicap limits are:":PRINT
11710 PRINT" Men    0 through 36"
11720 PRINT" Women  0 through 40"
11730 PRINT" Scratch  use + sign"
11740 GOSUB 580:X=-1:RETURN
11750 T1$=KB$+"*":LSET D4$=T1$:RSET C5$=D4$:GOTO 11980 'h'cap
11760 '+++++     course ID     +++++
11770 IF KB<>4 THEN 11950
11780 CLS:PRINT MNU4$:M1=0:GOSUB 540 'show courses
11790 PRINT:LINE INPUT"ENTER the line number of the NEW home course. ";KB$
11800 KB=VAL(KB$):IF KB>0 AND KB<=CMAX AND TMP(KB)=KB THEN 11830 'entry ok
11810 PRINT:PRINT "Please choose a line number from the list.."
11820 GOSUB 580:GOTO 11780
11830 IF B5$="00" OR INSTR(CN$,"*")<>0 THEN 11920 'tra if no home course yet
11840 PRINT:PRINT"A home course, ";CN$;", is already assigned for ";PN$;"."
11850 PRINT"Changing or reassigning home courses will erase all recorded"
11860 PRINT"gross scores and putts.  Scores will have to be built up at"
11870 PRINT"the new or reassigned home course."
11880 '
11890 PRINT:PRINT"This will not affect the player's adjusted gross scores nor"
11900 PRINT"the differentials used to calculate the player's handicap."
11910 RESTORE 816:GOSUB 600:IF KB$<>"Y" THEN 11980
11920 GOSUB 671:RSET E4$=STR$(KB):RSET B5$=E4$ 'course ID number
11930 LSET A5$="I" 'set invalid data flag
11940 '+++++     tee box     +++++
11950 CLS:PRINT MNU4$:PRINT
11960 KB=VAL(E4$):GOSUB 10840 'get new tee
11970 '+++++     update PDIR.DAT, PLAYER.DAT     +++++
11980 PUT #4,RN:PUT #5,RN:CLOSE #5,#4
11990 CLS:PRINT "UPDATE completed for ";B4$:X=1:GOSUB 550:GOSUB 580:RETURN
12000 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
12010 '     3.4. Delete a player from the directory
12020 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
12030 GOSUB 12040:GOTO 10070
12040 CLS:PRINT MNU5$
12050 '
12060 RESTORE 819:GOSUB 600:IF KB$<>"Y" THEN RETURN
12070 CLS:PRINT MNU5$
12080 X=1:GOSUB 550 'show roster
12090 IF PR=0 THEN GOSUB 580:RETURN
12100 '
12110 PRINT:LINE INPUT"ENTER the line number of the player you want to delete. ";KB$
12120 KB=VAL(KB$):IF KB>0 AND KB<=PMAX AND TMP(KB)=KB THEN RN=KB:GOTO 12150
12130 GOSUB 611:GOTO 12070
12140 '+++++
12150 RESTORE 820:GOSUB 600
12160 IF KB$<>"Y" THEN 12040
12170 X=-1:GOSUB 630 'reduce PACT count
12180 GOSUB 660:GET #4,RN
12190 M1$=B4$:GOSUB 661 'inits
12200 PUT #4,RN:CLOSE #4 'empty slot
12210 GOSUB 670:GOSUB 672:PUT #5,RN:CLOSE #5 'empty slot
12220 CLS:PRINT "Deletion completed for ";M1$
12230 X=1:GOSUB 550:GOSUB 580:RETURN
12240 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
12250 '     5. ERASE a players gross scores
12260 '+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
12270 GOSUB 12280:GOTO 10070
12280 CLS:PRINT MNU6$
12290 '
12300 RESTORE 835:GOSUB 600
12310 IF KB$<>"Y" THEN RETURN
12320 CLS:PRINT MNU6$:X=1:GOSUB 550 'show roster
12330 IF PR=0 THEN GOSUB 580:RETURN
12340 PRINT:LINE INPUT"ENTER the player's line number for erasing scores. ";KB$
12350 KB=VAL(KB$):IF KB>0 AND KB<=PMAX AND TMP(KB)=KB THEN RN=KB:GOTO 12380
12360 '
12370 GOSUB 611:GOTO 12320
12380 RESTORE 813:GOSUB 600
12390 IF KB$<>"Y" THEN 12280
12400 CLS:PRINT MNU6$:PRINT
12410 PRINT SPC(4)"1.  ERASE the gross scores for all rounds."
12420 PRINT SPC(4)"2.  ERASE the putting scores for all rounds."
12430 PRINT SPC(4)"3.  ERASE both the gross and putting scores."
12440 PRINT SPC(4)"4.  None of the above.  Don't erase anything."
12450 PRINT:PRINT SPC(8)"NOTE: This will not affect the adjusted gross scores"
12460 PRINT SPC(14)"used in calculating the players USGA handicap."
12470 PRINT:M1$="PRESS the number of your choice. (1,2,3 or 4) ":GOSUB 560
12480 IF KB>0 AND KB<5 THEN 12510
12490 PRINT:PRINT"You must choose a number from the list. Try again."
12500 GOSUB 580:GOTO 12400
12510 IF KB=4 THEN 12280 'save the day
12520 RESTORE 814:GOSUB 600:IF KB$<>"Y" THEN 12400
12530 GOSUB 660:GET#4,RN:CLOSE #4
12540 GOSUB 670:GET #5,RN:IF KB=2 THEN 12600
12550 '+++++     scores
12560 RSET E5$=MKI$(0):LSET F5$=STRING$(40,E5$):LSET G5$=STRING$(36,E5$)
12570 LSET H5$=STRING$(18,"9"):RSET I5$=MKI$(999)
12580 '+++++     putts
12590 IF KB<>3 THEN 12620
12600 RSET J5$=MKI$(0):LSET K5$=STRING$(40,J5$):LSET L5$=STRING$(36,J5$)
12610 LSET M5$=STRING$(18,"9"):RSET N5$=MKI$(999)
12620 PUT #5,RN:CLOSE #5
12630 CLS:PRINT MNU6$:PRINT:PRINT"Erasure completed for ";B4$
12640 GOSUB 580:RETURN
14000 '+++++     grunt work
14010 DELETE 490-9999
14020 SAVE"b:player.asc",A
14030 RUN"b:main.bas"
15000 'for chain delete
4000 '+++++     grunt work
14010 D