Play the classic crossword game.
Content
Image Gallery
Source Code
5 REM 4/16/85 Tape Name scrabble; by John Leary
6 REM subroutines; 7000 vars; 7500 intro; 7900 player names
7 REM 8500 order of play; 8900 start game
10 GO SUB 7000: GO SUB 7500: GO SUB 7900
40 GO SUB 8500
50 GO SUB 8800: DEF FN F(t,x,a,b)=t+(t AND x=a)+(2*t AND x=b): DEF FN F$(x$,t)=(x$ AND t=2)+(x$+x$ AND t=3): DEF FN E(a,x,b)=a*(x=z)+b*(x=y)-4
70 DEF FN B(x$,y$)=(y AND (x$=y$(y) OR x$=y$(2) OR x$=y$(3) OR x$=y$(4) OR x$=y$(5) OR x$=y$(6) OR x$=y$(7)))
75 DEF FN C$(x)=("row" AND x=z)+("column" AND x<>z): DEF FN D$(x$,a)=x$( TO a-y)+x$(a+y TO ): GO TO 1000
80 DEF FN m(a,b)=a+(b-a AND a>b)
90 LET x=ATTR (q,p): LET x=x-128*(x=168): LET y$=SCREEN$ (q,p): LET y$=y$+("\e" AND y$=""): RETURN
100 LET b=y: GO SUB 400: LET j$=j$+"!": LET x=x1: IF i=ic THEN FOR j=y TO 3: LET a$(4+j)="": NEXT j
105 FOR j=y TO x1: LET b$=("s" AND x>y)+("" AND x=y)
110 IF i<>ic THEN LET i$="Choose "+STR$ x+(" more" AND x<x1)+" letter"+b$+(" by typing any key" AND x=x1)+"."
115 IF i=ic THEN LET i$="My turn. I will choose "+STR$ x+(" more" AND x<>x1)+" letter"+b$+"."
120 GO SUB 300: GO SUB 500: PRINT AT 4,z;ll;" ": LET v=LEN v$
125 FOR k=y TO v: IF q$>v$(k) THEN GO TO 135
130 LET v$=v$( TO k-y)+q$+v$(k TO ): GO TO 145+(5 AND i<>ic)
135 NEXT k: LET v$=v$+q$
140 IF i<>ic THEN GO TO 150
145 LET a$(6)=(q$ AND FN B(q$,"AEIOUY ")=y)+a$(6): LET a$(5)=(q$ AND FN B(q$,"JQXZ* ")=z)+a$(5): LET a$(7)=(q$ AND (q$="*" OR q$="S"))+a$(7)
150 LET x=x-y: PRINT PAPER 5;AT y+g*i,21;v$: NEXT j: LET a$(i)=v$: IF i<>ic THEN RETURN
175 DIM e(20): LET j$=a$(5): GO SUB 410
190 FOR j=3 TO FN m(6,LEN j$): LET x=5*j-14: FOR l=y TO 3*(8-j): LET k$="": FOR e=y TO j
195 LET v(e)=y+INT (RND*LEN j$): FOR f=y TO e-y: IF v(f)=v(e) THEN GO TO 195
200 NEXT f: NEXT e
205 FOR e=y TO j: LET k$=k$+j$(v(e)): NEXT e: GO SUB 260
210 FOR e=x TO x+4: IF e(e)=s THEN GO TO 240
215 IF e(e)>s THEN GO TO 230
220 IF e(e)<s THEN IF e(e)=z THEN LET e(e)=s: GO TO 240
225 FOR f=4+x TO e+y STEP -y: LET e(f)=e(f-y): NEXT f: LET e(e)=s: GO TO 235
230 NEXT e: IF e(20)<>z THEN RETURN
235 IF e(x+4)<>z THEN GO TO 245
240 NEXT l
245 NEXT j: RETURN
250 IF xx>z THEN GO TO 260
255 LET b=y: LET i$=k$: GO SUB 500: LET b=z
260 LET s=z: FOR k=y TO LEN k$: LET t=y+(CODE k$(k)-64)*("@"<k$(k) AND k$(k)<"[")
275 LET s=s+VAL l$(t)+(l$(t)="9"): NEXT k: RETURN
300 RANDOMIZE : LET ll=LEN g$: LET u=y+INT (RND*ll): LET q$=g$(u): LET g$=FN D$(g$,u): LET ll=ll-y: RETURN
400 LET j$=p$(i): GO TO 410
405 LET j$=a$(i)
410 FOR k=LEN j$ TO y STEP -y: IF j$(k)=" " THEN LET j$=j$( TO k-y)
420 NEXT k: RETURN
500 PRINT AT 19,z;o$+o$+o$+o$+o$+o$: IF j$="" THEN PRINT AT 19,0;i$
510 IF j$<>"" THEN PRINT AT 19,z;j$'i$
520 BEEP .2,12: GO TO 530+10*b
530 PAUSE 90: RETURN
540 GO SUB 600: RETURN
550 GO SUB 600: IF n$="p" THEN LET r=r+y
555 RETURN
560 GO SUB 600: LET h=(y AND n$="h"): LET v=y-h: RETURN
570 GO SUB 600: LET e(j)=CODE n$-93: RETURN
600 IF xx=y THEN GO TO 660
605 PRINT FLASH y;AT g*i,21;"\::"
610 FOR l=y TO 18: PAUSE 35
620 GO TO 650-(20 AND l=y)-(5 AND l=10)
630 PRINT INK 2;AT y,y;" 2 double letter 2 double word"'; INK y;" 3 triple letter 3 triple word": INK z: GO TO 650
645 PRINT AT y,y;m$+" "+l$+" "
650 IF i=ic THEN GO TO 690
660 LET n$=INKEY$: IF n$<>"" THEN GO TO 690
670 IF xx=y THEN GO TO 660
680 NEXT l: GO TO 610
690 PRINT AT g*i,21;" ": RETURN
900 INPUT "Press enter to continue";j$: RETURN
1000 LET r1=z: FOR i=y TO nn: IF i=ic THEN GO SUB 3200: LET lw=z
1010 IF i<>ic THEN GO SUB 1500
1020 LET a$(i)=v$: PRINT AT 2+g*i,27;s(i); PAPER 5;AT y+g*i,21;a$(i): LET v=LEN v$: LET x1=FN m(ll,7-v)
1055 IF r=nn OR v+ll=z THEN LET xx=y: GO TO 9500
1060 IF v<7 AND ll>z THEN GO SUB 100
1100 NEXT i: GO TO 1000
1500 LET v$=a$(i): LET b=2: GO SUB 400: LET j$=j$+"!": LET i$="Your turn. To pass, type p. To play, type any other key."
1505 LET r1=r: GO SUB 500: IF r=r1 THEN GO TO 1550
1507 IF r=nn OR ll=z THEN RETURN
1510 INPUT "Enter the letters you want to discard. If all, enter ""7""; if none just press enter.";u$: IF u$="" THEN RETURN
1515 IF u$="7" THEN LET g$=g$+a$(i): LET v$="": RETURN
1520 GO SUB 1850: LET g$=g$+j$: RETURN
1550 LET j$="": LET b=3: LET r=z: LET i$="If your word is horizontal, typeh; if vertical, type v."
1560 GO SUB 500: IF h<2 THEN GO TO 1600
1580 LET b=z: LET i$="You must type h or v!": GO SUB 500: GO TO 1550
1600 FOR j=y TO 2: LET b$=("left" AND j=y)+("top" AND j=2): LET c$=FN C$(j-y)
1620 LET b=4: LET i$="Type the letter at the "+b$+" of the "+c$+" in which your first letter goes.": GO SUB 500
1640 IF e(j)>3 AND e(j)<19 THEN GO TO 1680
1660 LET b=z: LET i$=c$+"s A to O only": GO SUB 500: GO TO 1620
1680 NEXT j: LET q=e(y): LET p=e(2): LET b=z: GO SUB 400
1700 INPUT "Enter your letters. Use SYMBL SHIFT B for a blank.";u$: LET b=z
1735 IF xx>z AND LEN u$<2 THEN LET i$="The first word must contain at least two letters! Start over.": GO SUB 500: GO TO 1500
1740 GO SUB 1850: IF n>LEN u$ THEN GO TO 1800
1790 GO SUB 400: LET i$=u$(n)+" is not on your list! Choose another word.": GO SUB 500: GO TO 1500
1800 GO SUB 2200: LET b=y: RETURN
1850 LET j$=a$(i): GO SUB 405: LET v$=j$: LET j$=""
1860 FOR n=y TO LEN u$: IF u$(n)>"Z" THEN LET u$(n)=CHR$ (CODE u$(n)-32)
1870 LET t=LEN v$: FOR l=y TO t: IF u$(n)=v$(l) THEN LET v$=FN D$(v$,l): LET j$=j$+u$(n): GO TO 1890
1880 NEXT l: IF r=r1 AND i<>ic THEN RETURN
1890 IF u$(n)="*" AND r=r1 AND i<>ic THEN INPUT "Enter the letter your * stands for!";u$(n)
1900 NEXT n: RETURN
2200 LET u=LEN u$: LET t=y: LET hm=y: LET p0=p: LET q0=q
2210 LET k$=u$: LET c$="": LET s$="": LET w$="": LET x$=""
2220 FOR j=y TO u: IF p=19 OR q=19 THEN GO TO 2400
2240 GO SUB 90: LET x$=x$+STR$ x: LET s$=s$+y$: IF x<>40 THEN GO TO 2270
2250 LET hm=z: IF j>y THEN LET w$=w$+y$
2260 LET p=p+h: LET q=q+v: GO TO 2240
2270 LET z$=u$(j): PRINT PAPER 5; FLASH y;AT q,p;z$
2280 IF ATTR (q-h,p-v)=40 OR ATTR (q+h,p+v)=40 THEN LET hm=z
2290 LET p=p+h: LET q=q+v: NEXT j
2295 IF ATTR (q0-v,p0-h)=40 OR ATTR (q,p)=40 THEN LET hm=z
2300 IF SCREEN$ (11,11)<>"2" THEN GO TO 2330
2320 LET i$="The first word must include the center square (H,H). Start over.": GO SUB 500: GO TO 2425
2330 IF hm=z OR xx=7 THEN GO TO 2445
2340 LET i$="Your word must join the others! Start over.": GO SUB 500: GO TO 2425
2400 LET i$="Not enough room in "+FN C$(v)+"! Try again.": GO SUB 500
2425 FOR k=y TO LEN s$: LET x=VAL x$(2*k-y TO 2*k): LET x1=INT (x/8): PRINT INK x-8*x1; PAPER x1;AT q0+v*k-v,p0+h*k-h;s$(k)
2440 NEXT k: LET fm=(f+lw AND i=ic): LET em=(e AND i=ic): GO TO 1500+(i=ic)*1750
2445 LET j$="": IF i=ic THEN LET i$="Anyone object to my word? "+f$: GO SUB 500: GO SUB 2500
2450 IF i<>ic THEN LET i$="Position or spelling wrong? Cha-nge your mind? "+f$: GO SUB 500: GO SUB 2500
2455 GO TO 2460-5*(INKEY$="")-35*(INKEY$="y")
2460 LET xx=z: GO SUB 250: LET s(i)=s(i)+s+50*(LEN u$=7): LET x$=""
2475 FOR j=y TO LEN s$: LET q=q0+v*j-v: LET p=p0+h*j-h: IF ATTR (q,p)<59 THEN GO TO 2490
2480 LET x$=SCREEN$ (q,p): PRINT PAPER 5; FLASH z;AT q,p;x$: IF FN B(x$,"AEIOUY ")=y THEN LET r$=r$+CHR$ (q+61)+CHR$ (p+61)
2490 NEXT j: RETURN
2500 LET s1=z: LET p=p0: LET q=q0: FOR j=y TO LEN s$
2510 IF ATTR (q,p)<128 THEN GO TO 2650
2520 LET t1=y: LET t0=y: LET z$=SCREEN$ (q,p): IF j>s1 THEN LET s1=15: LET a=-y: LET s=FN E(p,v,q): GO SUB 2800
2540 LET b$="": LET s=VAL x$(2*j-y TO 2*j): IF s<>56 THEN LET t0=FN F(y,s,23,15): LET t=t*t0: LET t1=FN F(y,s,58,57)
2550 LET p1=p: LET q1=q: LET hm=FN E(p,h,q): FOR l=-y TO y STEP 2: FOR k=y TO hm
2560 LET p=p1+v*l*k: LET q=q1+h*l*k: GO SUB 90: IF x<>40 THEN GO TO 2580
2570 LET b$=(b$+y$ AND l=y)+(y$+b$ AND l=-y): NEXT k
2580 LET hm=14-hm: NEXT l: LET p=p1: LET q=q1: IF lw<>z THEN RETURN
2600 LET n$=FN F$(z$,t1): LET k$=k$+n$: IF b$<>"" THEN LET b$=b$+z$+n$
2610 LET b$=b$+FN F$(b$,t0): LET c$=c$+b$
2650 LET p=p+h: LET q=q+v: NEXT j
2660 LET a=y: LET p=p-h: LET q=q-v: LET s=14-FN E(p,v,q): GO SUB 2800
2670 IF u+LEN w$=y THEN GO TO 2690
2680 LET k$=k$+w$: LET n$=k$: FOR k=y TO t-y: LET k$=k$+n$: NEXT k: GO TO 2700
2690 IF xx=7 THEN LET k$=z$+z$
2700 LET k$=k$+c$: RETURN
2800 LET p1=p: LET q1=q
2820 FOR k=y TO s: LET p=p1+a*h*k: LET q=q1+a*v*k: GO SUB 90: IF x<>40 THEN GO TO 2880
2840 LET w$=w$+y$: NEXT k
2880 LET p=p1: LET q=q1: RETURN
3000 FOR f=y TO lw: IF ATTR (q3-f*v,p3-f*h)=40 THEN GO TO 3015
3010 NEXT f
3015 FOR j=y TO lw: IF ATTR (q3+j*v,p3+j*h)=40 THEN GO TO 3050
3020 NEXT j
3050 LET s1=f: LET s2=j: RETURN
3200 RETURN
5100 DATA "ADALCGCIDADHDOGCGGGIGMHDHLICIGIIIMLALHLOMGMIODOL","BBCCDDEEHHKKLLMMNNBNCMDLEKKELDMCNB","BFBJFBFFFJFNJBJFJJJNNFNJ","AAAHAOHAHOOAOHOO"
5200 DATA 13,6,z,"QUEASYZEALOT"
7000 RESTORE : LET y=SGN PI: LET z=NOT PI: LET lw=z: LET r=z: LET ll=7: LET xx=y: LET x1=7: LET b$=""
7005 LET r$="": LET u$="": LET h$="": LET f$=" If yes, type Y; if no, type any other key.": LET o$=" "
7010 LET m$="*ABCDEFGHIJKLMNOPQRSTUVWXYZ": LET l$="013321424185131139111144849"
7020 LET g$=m$+"*AAAAAAAABCDDDEEEEEEEEEEEFGGHIIIIIIIILLLMNNNNNOOOOOOOPRRRRRSSSTTTTTUUUVWY"
7050 DIM v(6): DIM s(4): DIM e(20): DIM a$(7,7)
7080 FOR j=z TO 6: POKE USR "e"+j,128: NEXT j: POKE USR "e"+7,255: RETURN
7500 GO SUB 7600: PRINT AT 10,12;"SCRABBLE": PAUSE 500: BORDER 5: PAPER 5: INK z: CLS
7520 PRINT AT 6,z;"We play on the TV screen. Type your words on the keyboard. Fol-low the prompts on the screen."''
7525 PRINT "I can play up to 3 human oppon-ents. Or up to 4 people can playeach other while I keep score."''
7530 PRINT "If a prompt uses ""enter"", you must press enter after typing your response."''
7540 PRINT "Before ""entering"", you can cor- rect errors by using CAPS SHIFT 0.": GO SUB 900: RETURN
7600 BORDER 7: PAPER 7: CLS : LET u=y: INK y+RND: FOR i=y TO 2: FOR j=z TO 252 STEP 2: PLOT 128,88: DRAW u*(j-126),-86*u: NEXT j
7640 FOR j=z TO 173 STEP 2: PLOT 128,88: DRAW 126*u,u*(j-86): NEXT j: LET u=-u: NEXT i: RETURN
7900 CLS : DIM p$(4,8): DIM e$(4,8): DIM t(4,10): DIM u(4): LET j$="": LET b=y: LET gg=y: FOR i=y TO 4
7920 BEEP .2,12: INPUT "HUMANS! Enter your names (up to 7 letters). When all are named, press enter to proceed.";e$(i)
8000 IF e$(i,y)=" " THEN GO TO 8120
8040 LET p$(i)=e$(i): PRINT e$(i): IF e$(i,8)=" " THEN GO TO 8080
8060 PRINT "name too long!": GO TO 7920
8080 NEXT i
8120 LET nh=i-y: LET g=8-nh: IF nh>y AND nh<4 THEN LET i$="Do you want me to play? "+f$: GO SUB 500
8130 LET nn=nh+(y AND nh=y OR INKEY$="y"): IF nn<>nh THEN LET e$(nn)="T/S2068": LET p$(nn)=e$(nn)
8140 LET g=8-nn: RETURN
8500 PAUSE 90: CLS : LET i$="Want to draw letters to see who goes first? "+f$
8520 LET ic=nn*(nn<>nh): GO SUB 500: IF INKEY$<>"y" THEN CLS : GO TO 8760
8540 FOR i=y TO nn: GO SUB 400: RANDOMIZE 500*(gg+nn+i)
8560 GO SUB 300: IF i<>ic THEN LET j$=j$+"!": LET i$="Type any key to choose a letter."
8565 IF i=ic THEN LET j$="": LET b=z: LET i$="My turn to choose."
8580 GO SUB 500: LET e(i)=CODE q$: GO SUB 400: PRINT AT 4+i,5;j$+" chose "+q$+"."
8620 FOR j=y TO LEN b$: IF q$=b$(j) THEN LET g$=g$+b$: GO TO 8700
8640 NEXT j: LET b$=b$+q$: NEXT i: LET g$=g$+b$: PRINT AT 19,z;o$+o$+o$+o$: GO TO 8730
8700 LET b=y: BEEP .2,12: PRINT "There is a tie. Draw again!": LET b$="": PAUSE 150: CLS : GO TO 8540
8730 FOR i=y TO nn: LET x=y+(e(i)<e(y))+(e(i)<e(2))+(e(i)<e(3))+(e(i)<e(4))
8750 LET p$(x)=e$(i): LET ic=x*(i=nn AND nn<>nh): NEXT i
8760 FOR i=y TO nn: GO SUB 400: PRINT AT 9+i,5;j$+" is "+("1st" AND i=y)+("2nd" AND i=2)+("3rd" AND i=3)+("4th" AND i=4)+"."
8765 NEXT i: GO SUB 900: RETURN
8800 LET xx=7: CLS : PRINT AT 8,7;"GAME ";gg;" STARTS NOW"''
8820 PRINT "Player's letters and scores are shown on the right. Prompts app-ear at the bottom."''
8840 PRINT "Lists of letter values and bonussquares alternate at the top."''
8850 PRINT "A ""*"" (SYMBL SHIFT B) is a blank-it can be used for any letter.": GO SUB 900: PAPER 7: CLS
9060 PRINT AT PI,4;m$(2 TO 16): FOR m=y TO 15: PRINT AT 3+m,3;m$(m+y): NEXT m: FOR n=z TO 15
9085 PLOT 32,144-8*n: DRAW 120,z: PLOT 32+8*n,144: DRAW z,-120: NEXT n: FOR e=y TO 4: READ c$: FOR f=y TO LEN c$ STEP 2
9120 PRINT INK 7-5*(e=y)-6*(e=3); PAPER 7-5*(e=2)-6*(e=4);AT CODE c$(f)-61,CODE c$(f+y)-61;2+(e>2): NEXT f: NEXT e
9200 INK z: PAPER 7: FOR i=y TO nn: PRINT AT g*i,22;p$(i);AT 2+g*i,21;"Score": LET v$="": GO SUB 100: NEXT i: RETURN
9500 LET t=z: LET w$="": LET b=z: IF v+ll=z THEN GO TO 9540
9520 LET i$="You each passed. Deduct unused letters from your scores.": GO SUB 500: GO TO 9560
9540 GO SUB 400: LET j$=j$+"! You're out of letters.": LET i$="Others deduct unused letters, and add them to your score."
9550 GO SUB 500: LET t=i: LET w$=a$(y)+a$(2)+a$(3)+a$(4): LET s(t)=-s(t)
9560 LET u$="": FOR i=y TO nn: LET s(i)=-s(i): LET k$=a$(i)+(w$ AND i=t): GO SUB 260: LET s(i)=s(i)+s: IF i<>t THEN LET s(i)=-s(i)
9570 PRINT AT 2+g*i,27;s(i);" ": BEEP .2,12: NEXT i
9580 GO SUB 900: LET h=z: LET z$="": FOR i=y TO nn: FOR j=y TO nn: IF s(i)<s(j) THEN GO TO 9700
9680 NEXT j: GO SUB 400: LET t=s(i): LET x$=(" and " AND h=y)+(", " AND h>y): LET h=h+y: LET z$=j$+x$+z$
9700 NEXT i: IF h=nn THEN GO TO 9750
9720 LET j$=("GREAT GAME, " AND t*nn>600)+("Good game, " AND t*nn>400 AND t*nn<=600)+z$+"!": LET i$="You win with a score of "+STR$ t+".": GO SUB 500: GO TO 9760
9750 LET j$="": LET i$="There's a "+STR$ h+"-way tie. Nobody wins!": GO SUB 500
9760 GO SUB 900: LET b=y: CLS : BORDER 6: PRINT AT 2,2;"Score thru Game ";gg;AT 4,z;"Game";AT 8+gg,z;"Total"
9820 FOR j=y TO gg: PRINT AT 6+j,4-LEN STR$ j;j: NEXT j
9840 FOR j=y TO nn: LET r=2+7*j: FOR i=y TO nn: IF p$(i)<>e$(j) THEN GO TO 9890
9860 LET t(j,gg)=s(i): GO SUB 400: PRINT AT 4+(j/2<>INT (j/2)),r+2-LEN j$;j$
9880 FOR k=y TO gg: PRINT AT 6+k,r-LEN STR$ t(j,k);t(j,k): NEXT k
9890 NEXT i: LET u(j)=u(j)+t(j,gg): PRINT " __________________________";AT 8+gg,r-LEN STR$ u(j);u(j): NEXT j
9900 FOR i=y TO nn: LET p$(i)=e$(i): NEXT i: LET gg=gg+y: GO SUB 900: BORDER 5
9920 LET i$="Want to play again?"+f$: GO SUB 500: IF INKEY$<>"y" AND INKEY$<>"Y" THEN GO TO 9990
9930 LET i$="Same players?"+f$: GO SUB 500: IF INKEY$<>"y" AND INKEY$<>"Y" THEN RUN
9940 GO SUB 7000: LET i$="Same order of play?"+f$: GO SUB 500: IF INKEY$="y" OR INKEY$="Y" THEN GO TO 50
9970 GO TO 40
9990 GO SUB 7600: PRINT AT 10,8;"PLAY AGAIN SOON"
9997 STOP
9998 CLEAR : SAVE "SCRABBLE" LINE 10