1000 !-------------------!
1010 ! ALPHA SCRABBLE !
1020 !-------------------!
1030 ! MODIFIED FOR MULTI-PLAYERS JUNE 1984, RIC WEINSTEIN,PRESTON MACON
1040 REM ...... COPYRIGHT JAN 1983, BOB FOWLER
1050
1060 !-------------------!
1070 ! MAP DEFINITIONS !
1080 !-------------------!
1090 MAP1 INLINE,S,100
1100 REM ...... LETTERS (98 LETTERS + 2 WILDCARDS)
1110 MAP1 L1
1120 MAP2 L11$,S,50,"AAAAAAAAABBCCDDDDEEEEEEEEEEEEFFGGGHHIIIIIIIIIJKLLL"
1130 MAP2 L12$,S,50,"LMMNNNNNNOOOOOOOOPPQRRRRRRSSSSTTTTTTUUUUVVWWXYYZ**"
1140 MAP1 L2, @L1
1150 MAP2 ALLTILES$,S,100
1160 MAP1 TILES$,S,100
1170
1180 REM ...... ARRAY OF BOARD LETTERS (ALPHA)
1190 MAP1 B1
1200 MAP2 BOARDL$(15,15),S,1 ! Actual letters in board (or blanks)
1210 MAP1 B2, @B1
1220 MAP2 BOARDL$,S,225 ! Used for whole-board searches
1230
1240 REM ...... ARRAY OF BOARD SCORES
1250 MAP1 B3
1260 MAP2 BOARDS(15,15),B,1 ! 0=blank or wildcard , 1-10=letter score
1270 MAP1 B4, @B3
1280 MAP2 B5$,S,225 ! Used to initialize BOARDS array
1290
1300 REM ...... ARRAY OF PREMIUMS
1310 MAP1 P1
1320 MAP2 PREMIUM(15,15),S,1 ! 0=none , 1=DL , 2=TL , 3=DW , 4=TW
1330 MAP1 P2, @P1
1340 MAP2 P301$,S,15,"400100040001004"
1350 MAP2 P302$,S,15,"030002000200030"
1360 MAP2 P303$,S,15,"003000101000300"
1370 MAP2 P304$,S,15,"100300010003001"
1380 MAP2 P305$,S,15,"000030000030000"
1390 MAP2 P306$,S,15,"020002000200020"
1400 MAP2 P307$,S,15,"001000101000100"
1410 MAP2 P308$,S,15,"400100030001004"
1420 MAP2 P309$,S,15,"001000101000100"
1430 MAP2 P310$,S,15,"020002000200020"
1440 MAP2 P311$,S,15,"000030000030000"
1450 MAP2 P312$,S,15,"100300010003001"
1460 MAP2 P313$,S,15,"003000101000300"
1470 MAP2 P314$,S,15,"030002000200030"
1480 MAP2 P315$,S,15,"400100040001004"
1490
1500 REM ...... TEST PLAY DATA ARRAYS
1510 REM ...... MULTIPLAY STORES ALL POSSIBLE PLAYS FROM 1 TABLE ENTRY
1520 REM # OF MULTIPLAYS RARELY EXCEEDS 10, BUT CAN !
1530 MAP1 MULTIPLAY(20)
1540 MAP2 MPROW,B,1
1550 MAP2 MPCOL,B,1
1560 MAP2 MPDIR,B,1 ! 0,1 FOR HORIZONTAL/VERTICAL
1570 MAP2 MPSCORE,B,2
1580 MAP1 MMP,F,6,20 ! MAXIMUM # OF WORDS IN MULTI-PLAY SCAN
1590
1600 REM ...... TABLEPLAYS STORES THE WORD TABLE DISPLAYED ON CRT
1610 MAP1 TABLEPLAY'ALL(11) ! ARRAY SIZE MUST = MTP+1 (SEE BELOW)
1620 MAP2 TABLEPLAY ! THIS ARRAY MATCHES MULTIPLAY ARRAY ABOVE
1630 MAP3 TPROW,B,1
1640 MAP3 TPCOL,B,1
1650 MAP3 TPDIR,B,1 ! 0,1 FOR HORIZONTAL/VERTICAL
1660 MAP3 TPSCORE,B,2
1670 MAP2 TPWORD$,S,15
1680 MAP1 MTP,F,6,10 ! MAXIMUM # OF WORDS IN TABLE OF PLAYS
1690
1700 REM ...... ACTUALPLAY STORES THE POSITIONS PLAYED (IN CASE OF ERASURE)
1710 MAP1 ACTUAL'PLAY(7)
1720 MAP2 PROW,B,1
1730 MAP2 PCOL,B,1
1740 MAP2 PCHAR$,S,1
1750 MAP1 NPTILES,F,6 ! NUMBER OF TILES PLAYED
1760
1770 REM ...... MISCELLANEOUS MAPS
1780 REM --------------- A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
1790 MAP1 LVAL$,S,52," 1 3 3 2 1 4 2 4 1 8 5 1 3 1 1 310 1 1 1 1 4 4 8 410"
1800 MAP1 RACK$(4),S,7 ! LETTERS IN PLAYERS' RACKS
1810 MAP1 LRACK$(4),S,7 ! PLAYER'S LAST RACK
1820 MAP1 NRACK$(4),S,7 ! NEW RACK (DURING REARRANGE)
1830 MAP1 WORKRACK$(4),S,7 ! WORK RACK AREA
1840 MAP1 PLAY$,S,15 ! WORD "PLAYED" ON BOARD
1850 MAP1 PLAYUCS$,S,15 ! PLAY IN UP CASE
1860 MAP1 PLAYWILD$,S,15 ! PLAY IN UPPER CASE + WILDCARDS
1870 MAP1 P3
1880 MAP2 PLAYSCR(15),B,1 ! LETTER VALUES IN PLAY
1890 MAP1 P4
1900 MAP2 PLAYWSCR(15),B,1 ! LETTER VALUES IN PLAY + WILDCARD CHANGES
1910 MAP1 CROSS'WORD$,S,15 ! CROSS WORD (PERPENDICULAR TO PLAY) WORK AREA
1920 MAP1 CWORD'SAVES(10) ! EXTRA WORDS DATA
1930 MAP2 CROSS'WORDS$,S,15
1940 MAP2 CROSS'WORD'SCORES,B,2
1950 MAP1 HOLES$,S,15 ! (INTERSECTION) HOLES IN PLAY WORD
1960 MAP1 FHOLE,F,6 ! FIRST HOLE IN PLAY WORD
1970 MAP1 CHAR$,S,1 ! 1-LETTER WORK AREA
1980 MAP1 NPLAYERS,B,4,1 ! NUMBER OF PLAYERS
1990 MAP1 ME(4),B,1 ! USER'S PLAYER NUMBER
2000 ME(1)=1:ME(2)=2:ME(3)=3:ME(4)=4
2010 MAP1 REPLACE$,S,7 ! REPLACEMENT TILES
2020 MAP1 SCORES(4),F,6 ! ALL PLAYERS' SCORES
2030 MAP1 VOWELS$,S,10,"AEIOUY*" ! ALL WORDS MUST HAVE >0 OF THESE
2040 MAP1 NOYES$,S,1 ! QUERY (Y,N,Q)
2050 MAP1 TEMP'FIELDS
2060 MAP2 WAIT,F,6
2070 MAP2 SEED,F,6
2080 MAP2 NOPLAYS,F,6
2090 MAP2 SCORE(4),F,6
2100 MAP2 LSCORE,F,6
2110 MAP2 NTP,F,6
2120 MAP2 YYY,F,6
2130 MAP2 SELECT,F,6
2140 MAP2 I,F,6
2150 MAP2 LP,F,6
2160 MAP2 NERROR,F,6
2170 MAP2 NHOLES,F,6
2180 MAP2 NMP,F,6
2190 MAP2 NVOWEL,F,6
2200 MAP2 LVALAN,F,6
2210 MAP2 NOLD,F,6
2220 MAP2 NNEW,F,6
2230 MAP2 MROW,F,6
2240 MAP2 MCOL,F,6
2250 MAP2 DROW,F,6
2260 MAP2 DCOL,F,6
2270 MAP2 PL,F,6
2280 MAP2 LMATCH,F,6
2290 MAP2 NMATCH,F,6
2300 MAP2 WN,F,6
2310 MAP2 CASE,F,6
2320 MAP2 R,F,6
2330 MAP2 L,F,6
2340 MAP2 FILEN,F,6
2350 MAP2 FNAME$,S,10
2360 MAP2 THERE,F,6
2370 MAP2 DTP,F,6
2380 MAP2 ITP,F,6
2390 MAP2 LTIME,F,6
2400 MAP2 ROW,F,6
2410 MAP2 COL,F,6
2420 MAP2 CLEAR,F,6
2430 MAP2 DUMMY,F,6
2440 MAP2 LVALA,F,6
2450 MAP2 P,F,6
2460 MAP2 WORD'SCORE,F,6
2470 MAP2 MULTIPLIER,F,6
2480 MAP2 PLAY'SCORE,F,6
2490 MAP2 IROW,F,6
2500 MAP2 ICOL,F,6
2510 MAP2 NCROSS,F,6
2520 MAP2 NINTERSECT,F,6
2530 MAP2 CROSS'FLAG,F,6
2540 MAP2 CROSS'WORD'SCORE,F,6
2550 MAP2 CROSS'MULTIPLIER,F,6
2560 MAP2 CWDIR,F,6
2570 MAP2 C1$,S,10
2580 MAP2 C2$,S,10
2590 MAP2 DUP,F,6
2600 MAP2 LVALN,F,6
2610 MAP2 LVALA$,S,10
2620 MAP2 FROW,F,6
2630 MAP2 CROW,F,6
2640 MAP2 FCOL,F,6
2650 MAP2 CCOL,F,6
2660 MAP2 CDROW,F,6
2670 MAP2 CDCOL,F,6
2680 MAP2 ROWX,F,6
2690 MAP2 COLX,F,6
2700 MAP2 AA,X,1
2710 MAP2 INITIALS(4),S,10
2720 !-------------!
2730 ! NEXT GAME !
2740 !-------------!
2750
2760 NEXT'GAME:
2770 WAIT=0
2780 !ON ERROR GO TO ABORT'GAME
2790 SEED=0 ! DELETE
2800 PRINT TAB(-1,0);
2810 INPUT "DO YOU WISH TO RESTART A PREVIOUS GAME ? ";YN$
2820 IF YN$[1,1] = "Y" THEN GOTO RESTART
2830 INPUT "ENTER RND SEED (DEFAULTS TO RANDOM SEED) : ",SEED ! ****** DELETE
2840 IF(SEED=0) THEN RANDOMIZE ELSE DUMMY=RND(-SEED) ! DELETE
2850 ENTER'PLAYERS:
2860 PRINT
2870 INPUT "ENTER THE NUMBER OF PLAYERS (FROM 1 TO 4) ";NPLAYERS
2880 IF (NPLAYERS <1) OR (NPLAYERS > 4) THEN PRINT TAB(24,1); "INVALID NUMBER... PLEASE RE-ENTER" : GOTO ENTER'PLAYERS
2890 PRINT
2900 FOR X = 1 TO NPLAYERS
2910 PRINT "ENTER PLAYER #";STR(X);"'S NAME "; : INPUT "";INITIALS(X)
2920 PRINT
2930 NEXT X
2940 PRINT TAB(-1,0); TAB(-1,12);
2950 REM ...... ASK FOR INITIALS ? USE INITIALS & STORE FINAL SCORES ?
2935 REM ...... PICK RANDOM NUMBER TO DECIDE WHO GOES FIRST
2960 REM ...... CLEAR BOARD OF LETTERS
2970 B5$="" ! initialize BOARDS values
2980 BOARDL$=SPACE(225) ! initialize BOARDL$ and BOARDL$(n,n)
2990
3000 REM ...... SHUFFLE LETTER "TILES"
3010 ! RANDOMIZE ! ****** REMOVE "!" AFTER DEBUGGING
3020 TILES$=ALLTILES$ ! START OFF WITH FULL 100 TILES
3030 GOSUB SHUFFLE'LETTERS
3040 GOSUB DISPLAY'BOARD
3050 GOSUB DISPLAY'MENU
3060 NOPLAYS=1 ! =0 AFTER FIRST PLAY
3070 FOR I = 1 TO 4 : SCORE(I)=0 : NEXT I
3080 LSCORE=0 ! SCORE BEFORE LAST MOVE
3090
3100 NEXT'TURN:
3110 NTP=0 : WILDCARD'LETTER$ = ""
3120 YYY = YYY + 1
3130 IF YYY = (NPLAYERS+1) THEN YYY = 1
3140 IF YYY = SKIP THEN PRINT TAB(23,1);TAB(-1,9);CHR$(7);"Player # ";&
STR(YYY);" lost turn because of challenge. CR to Continue"; : &
INPUT "";AAA :PRINT TAB(23,1);TAB(-1,9); SKIP = 0 :&
GOTO NEXT'TURN
3150 NEXT'TILE:
3160 IF(LEN(RACK$(YYY))=7 OR LEN(TILES$)=0) THEN GO TO DISPLAY'RACKS
3170 RACK$(YYY)=RACK$(YYY)+TILES$[1,1] ! PICK A TILE, ANY TILE
3180 TILES$=TILES$[2,LEN(TILES$)] ! REMOVE FROM PILE
3190 GO TO NEXT'TILE
3200
3210 DISPLAY'RACKS:
3220 LRACK$(YYY)=RACK$(YYY)
3230 LSCORE=SCORE(YYY)
3240 GOSUB DISPLAY'ALL'RACKS
3250 IF(LEN(RACK$(YYY)) > 0) THEN GO TO MENU
3260
3270 REM ...... WE HAVE USED UP ALL THE REMAINING TILES !
3280 REM GAME IS OVER & THIS PLAYER GETS EXTRA POINTS
3255 REM (= SUM OF ALL UNPLAYED TILES IN OTHER PLAYERS' RACKS)
3290 GO TO END'GAME
3300
3310 !-------------!
3320 ! MAIN MENU !
3330 !-------------!
3340
3350 MENU:
3360 SELECT=0
3370 PRINT TAB(16,50);SPACE(28);TAB(-1,12);TAB(16,50);"What next ? : ";CHR(7);
3380 INPUT "" SELECT
3390 PRINT TAB(24,1); TAB(-1,9);
3400 GOSUB WAIT
3410 ON SELECT GO TO REARRANGE'RACK,TRY'WORD,MAKE'PLAY,REPLACE'LETTERS
3420 ON SELECT-04 GO TO MENU2,QUIT,DELETE'PLAY
3430 ON SELECT-90 GO TO DISPLAY'TILES,SET'WAIT,REDO'DISPLAY,MEMORY
3440 ON SELECT-94 GO TO CONVENTION,TRAIL
3450 PRINT "Error --- illegal selection"; CHR(7);
3460 GO TO MENU
3470
3480 REARRANGE'RACK:
3490 PRINT TAB(16,50);TAB(-1,9);TAB(-1,12);"Enter letters";CHR(7);
3500 PLAY$=""
3510 NRACK$(YYY)=""
3520
3530 REARRANGE:
3540 IF(PLAY$="") THEN GO TO DISPLAY'ARR
3550 CHAR$=PLAY$[1,1]
3560 I=INSTR(1,RACK$(YYY),CHAR$)
3570 IF(I <> 0) THEN GO TO OK'ARR
3580 PRINT "Error---"; CHAR$; " not in rack"; CHR(7);
3590 GO TO DISPLAY'ARR
3600
3610 OK'ARR:
3620 NRACK$(YYY)=NRACK$(YYY)+CHAR$
3630 PLAY$=PLAY$[2,LEN(PLAY$)]
3640 IF(I=1) THEN RACK$(YYY)=RACK$(YYY)[2,LEN(RACK$(YYY))] : GO TO REARRANGE
3650 RACK$(YYY)=RACK$(YYY)[1,I-1]+RACK$(YYY)[I+1,LEN(RACK$(YYY))] : GO TO REARRANGE
3660
3670 DISPLAY'ARR:
3680 PRINT TAB(ME(YYY)+18,18); NRACK$(YYY); SPACE(8); TAB(ME(YYY)+18,26); RACK$(YYY);!SPACE(8);
3690 IF(LEN(RACK$(YYY))=0) THEN RACK$(YYY)=NRACK$(YYY) : &
GOSUB DISPLAY'RACK : GO TO MENU
3700 PRINT TAB(ME(YYY)+18,18+LEN(NRACK$(YYY)));
3710 PLAY$=""
3720 INPUT "" PLAY$
3730 PRINT TAB(24,1); TAB(-1,9);
3740 IF(LEN(PLAY$)=0) THEN PLAY$=RACK$(YYY)
3750 GO TO REARRANGE
3760
3770 TRY'WORD:
3780 IF(NTP=MTP) THEN PRINT CHR(7); : GO TO MENU
3790 IF(NTP=0) THEN GOSUB DISPLAY'TABLE'TITLE
3800 PRINT TAB(16,50);SPACE(29);TAB(16,50);TAB(-1,12); "If no more words, hit return";
3810 PRINT TAB(-1,11); TAB(NTP+1+4,49); NTP+1 USING "#Z"; " ";SPACE(27);TAB(-1,30);TAB(NTP+1+4,52);
3820 INPUT LINE "" PLAY$
3830 LP=LEN(PLAY$)
3840 GOSUB WAIT
3850
3860 REM ....... CHECK FOR RETURN (USER HAS NO MORE WORDS TO TRY)
3870 IF(LP > 0) THEN GO TO CHECK'ONE
3880 PRINT TAB(NTP+1+4,49);SPACE(30);TAB(NTP+1+4,49);
3890 IF(NTP=0) THEN GOSUB ERASE'TABLE
3900 GO TO MENU
3910
3920 CHECK'ONE:
3930 PRINT TAB(24,1); TAB(-1,9);
3940 IF(LP=1) THEN PRINT "Error --- need > 1 letters"; CHR(7); : GO TO TRY'WORD
3950 PLAYUCS$=UCS(PLAY$)
3960 NERROR=0
3970 NHOLES=0
3980 NMP=0
3990 NVOWEL=0
4000
4010 REM ...... SCAN PLAY WORD
4020 FOR I=1 TO LP
4030 CHAR$=PLAYUCS$[I,I]
4040 IF(CHAR$ <> PLAY$[I,I]) THEN NHOLES=NHOLES+1 : GO TO SCRL
4050 IF(CHAR$ >="A" AND CHAR$ <= "Z") THEN GO TO SCRL
4060 IF(CHAR$ <> "*") THEN NERROR=NERROR+1 ELSE PLAYSCR(I)=0
4070 GO TO ENDL1
4080 SCRL:
4090 GOSUB LETTER'SCORE
4100 PLAYSCR(I)=LVALN
4110 NVOWEL=NVOWEL+INSTR(1,VOWELS$,CHAR$)
4120 ENDL1:
4130 NEXT I
4140
4150 REM ...... ANY VOWELS ?
4160 IF(NVOWEL=0) THEN PRINT "Error---no vowels"; CHR(7); : GO TO TRY'WORD
4170 IF(NERROR=0) THEN GO TO DO'TRY
4180 PRINT "Error ---"; NERROR; "illegal letters (use A-Z,a-z,*)"; CHR(7);
4190 GO TO TRY'WORD
4200
4210 DO'TRY:
4220 REM ...... IF THERE ARE >0 HOLES, WE MAY SAFELY SCAN BOARD
4230 IF(NHOLES > 0) THEN GO TO SCAN'BOARD
4240 REM ...... IF NO HOLES, ASK FOR ROW,COLUMN,DIRECTION & BYPASS SCAN
4215 NOLD=0 : NNEW=0
4250 PRINT TAB(-1,12);
4260 FOR I=1 TO 15 : PRINT TAB(I+2,46); I USING "#Z"; : NEXT I
4270 ENTER'ROW:
4280 PRINT TAB(16,50); TAB(-1,9); TAB(-1,12);
4290 PRINT "Hit return to scan whole board";
4300 GOSUB WAIT
4310 MROW=0
4320 PRINT TAB(NTP+1+4,67);SPACE(13);TAB(-1,30);TAB(-1,11);TAB(NTP+1+4,67);
4330 INPUT "" MROW
4340 PRINT TAB(24,1); TAB(-1,9);
4350 IF(MROW=0) THEN GO TO HELP'COLUMN
4360 IF(MROW >= 1 AND MROW <= 15) THEN GO TO HELP'COLUMN
4370 PRINT "Error --- must be 1 to 15"; CHR(7);
4380 GO TO ENTER'ROW
4390
4400 HELP'COLUMN:
4410 FOR I=1 TO 15 : PRINT TAB(I+2,46); " "; : NEXT I
4420 IF(MROW=0) THEN GO TO SCAN'BOARD
4430 PRINT TAB(-1,12);
4440 PRINT TAB(18,1); "01 02 03 04 05 06 07 08 09 10 11 12 13 14 15";
4450 ENTER'COLUMN:
4460 PRINT TAB(16,50); TAB(-1,9);
4470 MCOL=0
4480 PRINT TAB(NTP+1+4,71); SPACE(8); TAB(-1,11);TAB(NTP+1+4,71);
4490 INPUT "" MCOL
4500 PRINT TAB(24,1); TAB(-1,9);
4510 IF(MCOL >= 1 AND MCOL <= 15) THEN GO TO HELP'DIRECTION
4520 PRINT "Error --- must be 1 to 15"; CHR(7);
4530 GO TO ENTER'COLUMN
4540
4550 HELP'DIRECTION:
4560 PRINT TAB(18,1); SPACE(44);
4570 ENTER'DIRECTION:
4580 CHAR$=""
4590 PRINT TAB(16,50); TAB(-1,9); TAB(-1,12);
4600 PRINT "Enter H(orizontal),V(ertical)";
4610 PRINT TAB(NTP+1+4,75); TAB(-1,11);
4620 INPUT "" CHAR$
4630 PRINT TAB(16,50); TAB(-1,9);
4640 PRINT TAB(24,1); TAB(-1,9);
4650 CHAR$=UCS(CHAR$)
4660 IF(CHAR$="H") THEN DROW=0 : DCOL=1 : GO TO CHECK'8'8
4670 IF(CHAR$="V") THEN DROW=1 : DCOL=0 : GO TO CHECK'8'8
4680 PRINT CHR(7);
4690 GO TO ENTER'DIRECTION
4700
4710 CHECK'8'8:
4720 IF (BOARDL$(8,8) <> "") THEN GOTO GOOD'INPUT
4730! IF(BOARDL$ <> "") THEN GO TO GOOD'INPUT ! CHECK FOR FIRST PLAY OF GAME
4740 IF(MROW > 8 OR (MROW+((LP-1)*DROW)) < 8) THEN GO TO BAD'INPUT
4750 IF(NOT(MCOL > 8 OR MCOL+(LP-1)*DCOL < 8)) THEN GO TO GOOD'INPUT
4760
4770 BAD'INPUT:
4780 PRINT "Error --- first play must cover center (8,8)"; CHR(7);
4790 GO TO ENTER'ROW
4800 GOOD'INPUT:
4810 PL=1
4820 GOSUB TEST'PLAY
4830
4840 CHECK'OLD'NEW:
4850 IF(NNEW > 0) THEN GO TO TRY'WORD
4860 PRINT "Warning --- no new plays possible";
4870 IF(NOLD > 0) THEN PRINT " ("; STR$(NOLD); " moves already in table)";
4880 GO TO TRY'WORD
4890
4900 SCAN'BOARD:
4910 IF(BOARDL$="") THEN GO TO FIRST'PLAY
4920 PL=0 ! PLAY LETTER BEING SCANNED
4930 NEXT'PL:
4940 IF(PL=LP) THEN GO TO END'SCAN
4950 PL=PL+1
4960 IF(NHOLES > 0 AND PLAYUCS$[PL,PL]=PLAY$[PL,PL]) THEN GO TO NEXT'PL
4970 LMATCH=0
4980
4990 NEXT'MATCH:
5000 NMATCH=INSTR(LMATCH+1,BOARDL$,PLAYUCS$[PL,PL])
5010 IF(NMATCH=0) THEN GO TO NEXT'PL
5020 MROW=INT((NMATCH-1)/15)+1 : MCOL=NMATCH-15*(MROW-1)
5030 DROW=0 : DCOL=1 : GOSUB TEST'PLAY : IF(NOYES$="Q") THEN GOTO TRY'WORD
5040 DROW=1 : DCOL=0 : GOSUB TEST'PLAY : IF(NOYES$="Q") THEN GOTO TRY'WORD
5050 LMATCH=NMATCH
5060 GO TO NEXT'MATCH
5070
5080 FIRST'PLAY:
5090 MROW=8 : MCOL=8
5100 PL=0
5110 FP1:
5120 PL=PL+1
5130 DROW=0 : DCOL=1 : GOSUB TEST'PLAY : IF(NOYES$="Q") THEN GOTO TRY'WORD
5140 DROW=1 : DCOL=0 : GOSUB TEST'PLAY : IF(NOYES$="Q") THEN GOTO TRY'WORD
5150 IF(PL<LP) THEN GO TO FP1
5160
5170 END'SCAN:
5180 GO TO CHECK'OLD'NEW
5190
5200 MAKE'PLAY:
5210 IF(NTP=0) THEN PRINT "Error --- no words in table"; CHR(7); : GO TO MENU
5220 WN=1
5230 FOR I=1 TO NTP
5240 IF(TPSCORE(I)>TPSCORE(WN)) THEN WN=I
5250 NEXT I
5260 PRINT TAB(16,50); TAB(-1,9); TAB(-1,12); "Which word # ? :"; WN;
5270 PRINT TAB(16,67);
5280 INPUT "" WN
5290 GOSUB WAIT
5300 PRINT TAB(24,1); TAB(-1,9);
5310 IF(WN >= 1 AND WN <= NTP) THEN GO TO DO'PLAY
5320 PRINT "Error --- not in table"; CHR(7);
5330 GO TO MENU
5340
5350 DO'PLAY:
5360 NTP=WN
5370 CASE=1
5380 GOSUB PLAY'WORD
5390 GOSUB ERASE'TABLE
5400 SCORE(YYY)=SCORE(YYY)+TPSCORE(NTP)
5410 IF(EOF(1)=-1) THEN GO TO CHALLENGE
5420 PRINT #1,TPWORD$(NTP);TAB(15);
543
0 PRINT #1, USING " #Z #Z !", TPROW(NTP),TPCOL(NTP),("HV")[TPDIR(NTP)+1,1];
5440 PRINT #1, USING " #ZZZ #ZZZ", TPSCORE(NTP),SCORE(NTP);
5450 PRINT #1,YYY;
5460 PRINT #1,WILDCARD'LETTER$
5470
5480 CHALLENGE:
5490 ! IF CHALLENGE SUCCEEDS ===> PLAYER LOSES TURN
5500 ! IF CHALLENGE FAILS ===> CHALLENGER LOSES NEXT TURN (FUTURE)
5510 ! AFTER CHALLENGE TIME, PLAYER IS IMMUNE TO FURTHER CHALLENGE
5520 CHAL = 1 : CALL DISPLAY'ALL'RACKS : CHAL = 0
5530 PRINT TAB(8,50);"Last word played was ";TPWORD$(NTP)
5540 PRINT TAB(10,50);
5550 INPUT "Challenge ?";CHAL$
5560 IF CHAL$[1,1] <> "Y" THEN PRINT TAB(8,50);SPACE(29);TAB(10,50);&
SPACE(29); : GOTO NEXT'TURN1
5570 PRINT TAB(10,50);
5580 INPUT "Player # that is challenging ";NUM
5590 SUCCEED:
5600 PRINT TAB(12,48);
5610 INPUT "Did challenge succeed ?";YESNO1$
5620 FOR X = 8 TO 12 : PRINT TAB(X,48);SPACE(31); : NEXT X
5630 IF YESNO1$[1,1] = "Y" THEN SKIP = 0 : CALL UNPLAY'WORD : GOTO NEXT'TURN1
5640 IF YESNO1$[1,1] = "N" THEN SKIP = NUM : GOTO NEXT'TURN1
5650 GOTO SUCCEED
5660 NEXT'TURN1:
5670 REM ...... END
5680 IF LEN(RACK$(YYY)) = 0 AND TILES$ = SPACE(100) THEN GOTO END'GAME
5690 GO TO NEXT'TURN
5700
5710 REPLACE'LETTERS:
5720 REPLACE$=""
5730 PRINT TAB(16,50); TAB(-1,9); "Which letters ? : ";
5740 INPUT "" REPLACE$
5750 PRINT TAB(24,1); TAB(-1,9);
5760 R=LEN(REPLACE$)
5770 IF(R=0) THEN PRINT CHR(7); : GO TO MENU
5780 IF(R > 7) THEN PRINT CHR(7); : GO TO REPLACE'LETTERS
5790 WORKRACK$(YYY)=RACK$(YYY)
5800 IF(LEN(TILES$) >= R) THEN GO TO REPLACE'CHECK
5810 PRINT "Error --- only"; LEN(TILES$); "tiles left"; CHR(7);
5820 GO TO REPLACE'LETTERS
5830
5840 REPLACE'CHECK:
5850 NERROR=0
5860 FOR L=1 TO R
5870 I=INSTR(1,WORKRACK$(YYY),REPLACE$[L,L])
5880 IF(I=0) THEN NERROR=NERROR+1 : GO TO ENDL3
5890 IF(I=1) THEN WORKRACK$(YYY)=WORKRACK$(YYY)[I+1,LEN(WORKRACK$(YYY))] : GO TO ENDL3
5900 WORKRACK$(YYY)=WORKRACK$(YYY)[1,I-1]+WORKRACK$(YYY)[I+1,LEN(WORKRACK$(YYY))]
5910 ENDL3:
5920 NEXT L
5930
5940 IF(NERROR=0) THEN GO TO DO'REPLACE
5950 PRINT "Error --- mismatches rack"; CHR(7);
5960 GO TO REPLACE'LETTERS
5970
5980 DO'REPLACE:
5990 RACK$(YYY)=WORKRACK$(YYY)+TILES$[1,R]
6000 GOSUB DISPLAY'RACK
6010 TILES$=TILES$[R+1,LEN(TILES$)]+REPLACE$
6020 GOSUB SHUFFLE'LETTERS
6030 IF(NTP > 0) THEN GOSUB ERASE'TABLE
6040 GO TO NEXT'TURN
6050
6060 QUIT:
6070 REM ------ CHANGE THIS FOR MULTIUSERS
6080 PRINT #1,"//"
6090 PRINT #1,BOARDL$
6095 PRINT #1,B5$
6100 PRINT #1,NPLAYERS
6110 FOR X = 1 TO NPLAYERS : PRINT #1,RACK$(X) : NEXT X
6120 FOR X = 1 TO NPLAYERS : PRINT #1,SCORE(X) : NEXT X
6130 FOR X = 1 TO NPLAYERS : PRINT #1,INITIALS(X) : NEXT X
6140 PRINT #1,TILES$ : PRINT #1,YYY
6150 GO TO END'GAME
6160
6170 MENU2:
6180 PRINT "5=this,6=quit,7=delete,";
6190 PRINT "91=tiles,92=wait,93=crt,94=mem,95=demo,96=trail";
6200 GO TO MENU
6210
6220 DISPLAY'TILES:
6230 L=LEN(TILES$)
6240 PRINT "Tiles left : ";
6250 FOR I=0 TO 5 : PRINT TILES$[10*I+1;10]; " "; : NEXT I
6260 ! IF(L > 60) THEN PRINT TAB(23,79-(L-60)); TILES$[61,L];
6270 GO TO MENU
6280
6290 SET'WAIT:
6300 PRINT TAB(16,50); TAB(-1,9); "Seconds to wait : ";
6310 INPUT "" WAIT
6320 GO TO MENU
6330
6340 REDO'DISPLAY:
6350 PRINT TAB(-1,0); TAB(1,15); TAB(-1,12); "ALPHA SCRABBLE";
6360 GOSUB DISPLAY'BOARD
6370 GOSUB DISPLAY'MENU
6380 GOSUB DISPLAY'ALL'RACKS
6390 GOSUB DISPLAY'TABLE
6400 GO TO MENU
6410
6420 MEMORY:
6430 PRINT "Memory left ="; MEM; "bytes";
6440 GO TO MENU
6450
6460 CONVENTION:
6470 TILES$[ 1, 50]="NAEEIRLEFASSROOINEJPSTTIVOAEGADTWHANLEAEEIEGUMIQYV"
6480 TILES$[51,100]="SONPKEMFRXEGBIIBRNRU*IYTDLHTZWAOCOOLNOIDTUDUCAREA*"
6490 RACK$(YYY)=""
6500 GO TO NEXT'TURN
6510
6520 TRAIL:
6530 IF(EOF(1)=0) THEN GO TO MENU
6540 FILEN=0
6550 LOOKUP:
6560 FILEN=FILEN+1
6570 FNAME$="TRAIL."+STR(FILEN)
6580 LOOKUP FNAME$,THERE
6590 IF(THERE <> 0) THEN GO TO LOOKUP
6600
6610 REM ...... NAME FOUND
6620 OPEN #1, FNAME$, OUTPUT
6630 PRINT "Trail kept in file "; FNAME$;
6640 PRINT #1, "TRAIL OF SCRABBLE GAME FROM SEED"; SEED
6650 PRINT #1
6660 PRINT #1, "WORD----------- RW CL D SCOR TSCR P WL"
6670 GO TO MENU
6680
6690 REM ...... PUT OTHER SECRET COMMANDS HERE
6700
6710 DELETE'PLAY:
6720 IF(NTP=0) THEN PRINT "Error---no plays"; CHR(7); : GO TO MENU
6730 PRINT TAB(16,50); "Delete which # : ";
6740 DTP=0
6750 INPUT "" DTP
6760 PRINT TAB(24,1); TAB(-1,9);
6770 IF(DTP > 0 AND DTP <= NTP) THEN GO TO DO'DELETE
6780 PRINT "Error---out of range"; CHR(7); : GO TO MENU
6790
6800 DO'DELETE:
6810 NTP=NTP-1
6820 FOR ITP=DTP TO NTP+1
6830 IF(ITP <= NTP) THEN TABLEPLAY'ALL(ITP)=TABLEPLAY'ALL(ITP+1)
6840 NEXT ITP
6850 GOSUB DISPLAY'TABLE
6860 GO TO MENU
6870
6880 REM ...... STORE FINAL SCORES IN DATA FILE ?
6890
6900 WAIT:
6910 LTIME=TIME
6920 WAIT'LOOP:
6930 IF( (TIME-LTIME)/60 < WAIT) THEN GO TO WAIT'LOOP
6940 RETURN
6950
6960 END'GAME:
6970 ABORT'GAME:
6980 SAVE'YYY = YYY
6990! GOSUB DISPLAY'ALL'RACKS
7000 IF LEN(RACK$(YYY))<>0 THEN GOTO FINISH
7010 NEXT'END:
7020 YYY = YYY + 1
7030 IF YYY > NPLAYERS THEN YYY = 1
7040 IF YYY = SAVE'YYY THEN GOTO DETERMINE'WINNER
7050 CALL DISPLAY'RACK
7060 FOR I=1 TO LEN(RACK$(YYY))
7070 CHAR$=RACK$(YYY)[I,I]
7080 GOSUB LETTER'SCORE
7090 TEMP'SCORE = TEMP'SCORE + LVALN
7100 NEXT I
7110 SCORE(YYY) = SCORE(YYY)-TEMP'SCORE
7120 SCORE(SAVE'YYY) = SCORE(SAVE'YYY)+TEMP'SCORE
7130 GOTO NEXT'END
7140 DETERMINE'WINNER:
7150 YYY = SAVE'YYY
7160 CALL DISPLAY'RACK
7170 WINNER = SCORE(1) : PLAYER = 1
7180 FOR X = 2 TO NPLAYERS
7190 IF WINNER < SCORE(X) THEN WINNER = SCORE(X) : PLAYER = X
7200 NEXT X
7210 PRINT TAB(10,50);"THE GAME IS OVER THE "
7220 PRINT TAB(12,50);"WINNER IS PLAYER #";STR(PLAYER);" ";INITIALS(PLAYER);
7230 PRINT TAB(14,50);"CONGRATULATIONS !"
7240 IF EOF(1) = 0 THEN CLOSE #1
7250 END
7260 FINISH:
7270 IF(NTP > 0) THEN GOSUB ERASE'TABLE
7280 PRINT TAB(-1,12); TAB(24,1); TAB(-1,9);
7290 IF(EOF(1)=0) THEN CLOSE #1
7300 END
7310
7320 !---------------------------!
7330 ! VARIOUS SCREEN DISPLAYS !
7340 !---------------------------!
7350
7360 DISPLAY'BOARD:
7370 PRINT TAB(-1,36);
7380 PRINT TAB(1,15); "ALPHA SCRABBLE";
7390 FOR ROW=1 TO 15
7400 FOR COL=1 TO 15
7410 GOSUB DISPLAY'LETTER
7420 NEXT COL
7430 NEXT ROW
7440 PRINT TAB(-1,11);
7450 FOR ROWX = 2 TO 15
7460 PRINT TAB(ROWX,80);TAB(-1,30);TAB(ROWX+1,45);TAB(-1,31);
7470 NEXT ROWX
7480 PRINT TAB(-1,23);
7490 FOR COLX = 3 TO 42 STEP 3
7500 FOR ROWX = 3 TO 17
7510 PRINT TAB(ROWX,COLX);TAB(-1,47);
7520 NEXT ROWX
7530 NEXT COLX
7540 PRINT TAB(-1,24);
7550 FOR X = 1 TO NPLAYERS : PRINT TAB(X+18,35); INITIALS(X); : NEXT X
7560 PRINT TAB(-1,37);
7570 RETURN
7580
7590 DISPLAY'MENU:
7600 PRINT TAB(16,50); "What next ? : ";
7610 PRINT TAB(18,50); "(1) Rearrange letters";
7620 PRINT TAB(19,50); "(2) Try word";
7630 PRINT TAB(20,50); "(3) Make play";
7640 PRINT TAB(21,50); "(4) Replace letters";
7650 PRINT TAB(22,50); "(5) 2nd Menu";
7660 RETURN
7670
7680 ERASE'MENU:
7690 FOR I=16 TO 22
7700 PRINT TAB(I,50); TAB(-1,9);
7710 NEXT I
7720 RETURN
7730
7740 DISPLAY'ALL'RACKS:
7750 CLEAR=1 ! # OF SPACES TO CLEAR RACK DISPLAY
7760 PRINT TAB(-1,11);
7770 FOR I=1 TO NPLAYERS
7780 PRINT TAB(I+18,1);"Player #";STR$(I);" : ";SCORE(I) USING "#ZZZ";" ";
7790 REM ...... DISPLAY A "#" FOR EACH LETTER IN A PLAYER'S RACK AND LETTER VALUE
7800 PRINT ("####### #######")[1,15]; SPACE$(CLEAR);
7810 NEXT I
7820 IF CHAL = 1 THEN RETURN
7830 DISPLAY'RACK:
7840 PRINT TAB(23,1);:INPUT "CR TO CONTINUE ";AA:PRINT TAB(23,1);SPACE(17);
7850 PRINT TAB(-1,12);
7860 P
