Scrabble

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