1 REM *** BBC VERSION *** 10 GOTO 500 20 ** WORDGRAM ** 30 CONVERTED & MODIFIED FOR BBC MICRO 40 BY Max lang 29 June 1983 50 : 60 FROM A SPECTRUM PROGRAM 70 BY MICHAEL BEWS 80 : 90 : 100 ROUTINE INDEX 110 ------------- 120 MAIN PROGRAM:......500 130 INITATE:..........1000 140 OPTIONS:..........1200 150 OWNWORD:..........1400 160 VALIDATE:.........1500 170 GAME CHOICE:......1600 180 NORMAL:...........1700 190 JUMBLED:..........2000 200 SETUP:............2300 210 GUESS:............2500 220 RESIGN:...........2700 230 NO:...............2800 240 YES...............2900 250 CHECK:............3000 260 RETURN:...........3100 270 ENDING:...........3300 280 MOVE LETTER:......3500 290 INSTRUCTIONS:.....3600 300 TITLE:...........10000 310 WAIT:............10200 320 YN:..............10300 330 SPACEBAR:........10500 340 BYE:.............10600 350 CHAR:............20000 360 SHUFFLE:.........20100 370 :::::::::::::::::::::::::::::::::: 500 REM MAIN PROGRAM 510 MODE 7 520 PROC_TITLE("** WORDGRAM **",1) 530 PROC_INITIATE 540 PROC_OPTIONS 550 GOTO 1610 560 PRINT TAB(0,23)"Another go ? (Y/N) "; 570 PROC_YN 580 IF YES THEN PRINT "Yes"; ELSE PRINT " No"; 590 PROC_WAIT(150) 600 IF YES THEN GOTO 540 610 PROC_BYE 620 :::::::::::::::::::::::::::::::::: 1000 DEF PROC_INITIATE 1010 DIM D$(7,12) 1020 RESTORE 1100 1030 FOR X=1 TO 7 1040 FOR Y=1 TO 12 1050 READ D$(X,Y) 1060 NEXT Y 1070 NEXT X 1080 RG=0: REM WORDS RIGHT 1090 ENDPROC 1100 DATA GATE,LINK,BUSH,EDGE,PLAN,AUNT,PI NE,LEAF,WITH,MILE,STEP,PEST 1110 DATA CHAIR,NIECE,GRASS,PIANO,CELLO,RA DIO,NYLON,MANOR,BRICK,APPLE,RIVER,SPICE 1120 DATA FAMILY,PALACE,PLAUQE,CINEMA,WIND OW,FLOWER,FATHER,SISTER,FRIEND,PEANUT,MINUTE, MIDDLE 1130 DATA PENDANT,OMNIBUS,CARAVAN,FEATHER, DIAMOND,MASONRY,CHIMNEY,PACKAGE,MUSTARD,SWALL OW,BICYCLE,BISCUIT 1140 DATA CHILDREN,NECKLACE,POSTCARD,PANOR AMA,MATERIAL,FARMYARD,BLUEBELL,THOUSAND,PROSP ECT,ELECTION,MULTIPLY,DIVIDEND 1150 DATA WATERFALL,FURNITURE,BOOKSHELF,AE ROPLANE,PINEAPPLE,NEWSPAPER,GRAPEVINE,DESTITU TE,FANTASTIC,PHOTOCOPY,DORMITORY,TELEPHONE 1160 DATA BENEFACTOR,HEREDITARY,PARLIAMENT ,ELEMENTARY,GREENHOUSE,STRAWBERRY,SOMERSAULT, SUPPLEMENT,HENCEFORTH,ELECTRICAL,COMPENSATE,G RADUATION 1170 :::::::::::::::::::::::::::::::::: 1200 DEF PROC_OPTIONS 1210 CLS 1220 PRINT TAB(0,1)"WORDGRAM" 1230 PRINT "--------" 1240 PRINT:PRINT "You have the following o ptions :-" 1250 PRINT:PRINT "A) Press any number betw een 4 and 9 for the minimum number of lett ers that you require the word to contain ." 1260 PRINT:PRINT "B) Press B for a word co ntaining less than seven letters." 1270 PRINT:PRINT "C) Press C if you want t o use your own word." 1280 PRINT TAB(20,16); 1290 P=FN_CHAR("456789BC") 1300 IF P=8 THEN PROC_OWNWORD:ENDPROC 1310 IF P=7 THEN R=RND(3) ELSE R=RND(8-P)+ P-1 1320 RR=RND(12) 1330 WORD$=D$(R,RR) 1340 ENDPROC 1350 :::::::::::::::::::::::::::::::::: 1400 DEF PROC_OWNWORD 1410 PRINT TAB(0,18)"Enter your own word ( in CAPITALS)" 1420 INPUT WORD$ 1430 PROC_VALIDATE(WORD$) 1440 IF valid THEN ENDPROC 1450 PRINTTAB(0,18)"Invalid character - ag ain in CAPITALS 1460 PROC_WAIT(200) 1470 PRINT TAB(0,19)STRING$(40," "):PRINT TAB(0,19); 1480 GOTO 1420 1490 :::::::::::::::::::::::::::::::::: 1500 DEF PROC_VALIDATE(V$) 1510 valid=-1 1520 FOR X=1 TO LEN(V$) 1530 M=ASC(MID$(V$,X,1)) 1540 IF M<65 OR M>90 THEN valid=0 1550 NEXT X 1560 ENDPROC 1570 :::::::::::::::::::::::::::::::::: 1600 DEF PROC_GAME_CHOICE 1610 PRINT TAB(0,21)"Do you require 1) Nor mal game" 1620 PRINT " OR 2) Jumbled game " 1630 F=FN_CHAR("12") 1640 PROC_WAIT(150) 1650 IF F=1 THEN PROC_NORMAL ELSE PROC_JUM BLED 1660 REM 1670 GOTO560 1680 :::::::::::::::::::::::::::::::::: 1700 DEF PROC_NORMAL 1710 PROC_SETUP("NORMAL") 1720 PRINT TAB(0,17)"GUESSES MADE" 1730 GM=0 1740 PRINT TAB(13,17);GM:PRINT TAB(0,14)ST RING$(40," ") 1750 PRINT TAB(0,12)"Press SPACEBAR to gue ss word TAB to resign" 1760 *FX21,0 1770 G=GET 1780 PRINT TAB(0,12)STRING$(80," ") 1790 IF G=32 THEN PROC_GUESS:GOTO 1930 1800 IF G=9 THEN PROC_RESIGN:ENDPROC 1810 G=G+32*(G>95): REM CONVERT TO CAPITAL S 1820 IF G<65 OR G>90 THEN GOTO 1750 1830 GM=GM+1 1840 G$=CHR$(G) 1850 IF INSTR(GUES$,G$) THEN PRINT TAB(0,1 2)"ALREADY GUESSED CORRECTLY":GOTO 1930 1860 IF TRIED$="" THEN GOTO 1880:REM KNOWN BUG IN OS1.2 1870 IF INSTR(TRIED$,G$) THEN PRINT TAB( 0,12)"ALREADY GUESSED INCORRECTLY":GOTO 1930 1880 P=INSTR(WORD$,G$) 1890 IF P=0 THEN PROC_NO:GOTO 1930 1900 PROC_YES:IF P=LW THEN GOTO 1930 1910 P=INSTR(WORD$,G$,P+1) 1920 IF P<>0 THEN GOTO 1900 1930 PROC_WAIT(150) 1940 PROC_CHECK 1950 IF NOT CORRECT THEN GOTO 1740 1960 RG=RG+1 1970 PRINT TAB(13,17);GM;" WORDS RIGHT ";R G 1980 ENDPROC 1990 :::::::::::::::::::::::::::::::::: 2000 DEF PROC_JUMBLED 2010 PROC_SETUP("JUMBLED") 2020 J$=FN_SHUFFLE(WORD$) 2030 LFT$=J$ 2040 FOR X=1 TO LW 2050 PRINT TAB(2*X,6);MID$(J$,X,1) 2060 NEXT X 2070 PRINT TAB(0,12)"Press TAB to resign" 2080 PRINT TAB(7,13)"(1) to return letter" 2090 PRINT TAB(7,14)"(2) to shift letters to end" 2100 PRINT TAB(0,10);STRING$(40," ") 2110 PRINT TAB(0,10); 2120 G=GET 2130 IF G=9 THEN PROC_RESIGN:ENDPROC 2140 IF G=49 THEN PROC_RETURN 2150 IF G=50 THEN PROC_ENDING 2160 G=G+32*(G>95): REM CONVERT TO CAPITAL S 2170 IF G<65 OR G>90 THEN GOTO 2120 2180 G$=CHR$(G) 2190 P=INSTR(LFT$,G$) 2200 IF P=0 THEN PRINT TAB(10,10)"No ";G$; "'s remaining":PROC_WAIT(200):GOTO 2100 2210 PROC_MOVE_LETTER 2220 PROC_CHECK 2230 IF INSTR(GUES$," ")=0 AND NOT CORRECT THEN GOTO 2010 2240 IF NOT CORRECT THEN GOTO 2100 2250 PRINT STRING$(80," ") 2260 ENDPROC 2270 :::::::::::::::::::::::::::::::::: 2300 DEF PROC_SETUP(T$) 2310 CLS 2320 PRINT TAB(0,1)"WORDGRAM - ";T$;" GAME " 2330 PRINT "--------" 2340 LW=LEN(WORD$) 2350 FOR X=1 TO LW 2360 PRINT TAB(2*X,5)"-" 2370 NEXT X 2380 TRIED$="" 2390 GUES$=STRING$(LW," ") 2400 O$="" 2410 ENDPROC 2420 :::::::::::::::::::::::::::::::::: 2500 DEF PROC_GUESS 2510 PRINT TAB(0,12)"Enter your guess word now" 2520 PRINT TAB(0,14); 2530 PRINT TAB(0,14)STRING$(40," ") 2540 PRINT TAB(0,14); 2550 INPUT GW$ 2560 PROC_VALIDATE(GW$) 2570 IF valid THEN GOTO 2610 2580 PRINT TAB(0,12)"Invalid character - e nter again" 2590 PROC_WAIT(150) 2600 GOTO 2520 2610 IF GW$<>WORD$ THEN PRINT TAB(0,12)"WR ONG WORD - KEEP TRYING ":ENDPR OC 2620 GUES$=GW$ 2630 FOR X=1 TO LW 2640 PRINT TAB(2*X,4);MID$(GUES$,X,1) 2650 NEXT X 2660 GM=GM+1 2670 ENDPROC 2680 :::::::::::::::::::::::::::::::::: 2700 DEF PROC_RESIGN 2710 FOR X=1 TO LW 2720 PRINT TAB(2*X,4)MID$(WORD$,X,1) 2730 NEXT X 2740 FOR X=1 TO 3:SOUND1,-15,12-3*X,20:SOU ND0,-10,6,20:NEXT X 2750 ENDPROC 2760 :::::::::::::::::::::::::::::::::: 2800 DEF PROC_NO 2810 PRINT TAB(2,12)"NO" 2820 SOUND1,-15,3,0: 2830 TRIED$=TRIED$+G$ 2840 PRINT TAB(0,6)TRIED$ 2850 ENDPROC 2860 :::::::::::::::::::::::::::::::::: 2900 DEF PROC_YES 2910 PRINT TAB(0,12)"** YES **" 2920 SOUND1,-15,120,20 2930 GUES$=LEFT$(GUES$,P-1)+G$+MID$(GUES$, P+1) 2940 PRINT TAB(2*P,4)G$ 2950 ENDPROC 2960 :::::::::::::::::::::::::::::::::: 3000 DEF PROC_CHECK 3010 CORRECT=0 3020 IF GUES$=WORD$ THEN CORRECT=-1 ELSE E NDPROC 3030 PRINT TAB(0,12);CHR$(136);" ** CO RRECT ** " 3040 PRINT STRING$(80," ") 3050 FOR X=1 TO 150:SOUND1,-15,5*X,1:NEXT X 3060 ENDPROC 3070 :::::::::::::::::::::::::::::::::: 3100 DEF PROC_RETURN 3110 IF O$="" THEN ENDPROC 3120 P=ASC(O$)-32 3130 O$=MID$(O$,2) 3140 G$=MID$(GUES$,P,1) 3150 PRINT TAB(2*P,4)" " 3160 GUES$=LEFT$(GUES$,P-1)+" "+MID$(GUES$ ,P+1) 3170 X=0 3180 X=X+1 3190 IF MID$(LFT$,X,1)<>" " THEN GOTO 3180 3200 LFT$=LEFT$(LFT$,X-1)+G$+MID$(LFT$,X+1 ) 3210 PRINT TAB(2*X,6)G$ 3220 ENDPROC 3230 :::::::::::::::::::::::::::::::::: 3300 DEF PROC_ENDING 3310 T$="" 3320 X=0 3330 X=X+1 3340 IF MID$(GUES$,X,1)<>" " THEN T$=T$+MI D$(GUES$,X,1) 3350 IF X<LW THEN GOTO 3330 3360 GUES$=STRING$(LW-LEN(T$)," ")+T$ 3370 FOR X=1 TO LW 3380 PRINT TAB(2*X,4)MID$(GUES$,X,1) 3390 NEXT X 3400 ENDPROC 3410 :::::::::::::::::::::::::::::::::: 3500 DEF PROC_MOVE_LETTER 3510 LFT$=LEFT$(LFT$,P-1)+" "+MID$(LFT$,P+ 1) 3520 PRINTTAB(2*P,6)" " 3530 P=INSTR(GUES$," ") 3540 PRINT TAB(2*P,4)G$ 3550 GUES$=LEFT$(GUES$,P-1)+G$+MID$(GUES$, P+1) 3560 O$=CHR$(P+32)+O$ 3570 ENDPROC 3580 :::::::::::::::::::::::::::::::::: 3600 DEF PROC_INSTRUCT 3610 CLS 3620 PRINT TAB(0,1)"WORDGRAM" 3630 PRINT "---------" 3640 PRINT:PRINT "This game has two option s" 3650 PRINT:PRINT " 1) To try to guess a hiden word - as in HANGMAN. I will keep a check of the letters that you have used." 3660 PRINT " 2) To try to sort out a jum bled word." 3670 PRINT "You can set your own words or I will choose one for you if you tell me h ow hard or easy you want it." 3680 PROC_SPACEBAR 3690 ENDPROC 3700 :::::::::::::::::::::::::::::::::: 10000 DEF PROC_TITLE(T$,I):REM I=0 - NO INS TRUCTION OPTION, I=1 - OPTION 10010 CLS 10020 PRINT TAB(1,1)"Max Lang" 10030 PRINTTAB(19-LEN(T$)/2,10)CHR$(141);T$ 10040 PRINTTAB(19-LEN(T$)/2,11)CHR$(141);T$ 10050 PROC_WAIT(150) 10060 IF I=0 THEN ENDPROC 10070 PRINT TAB(0,22)"Do you require instru ctions ? "; 10080 PROC_YN 10090 IF YES THEN PRINT "Yes"; ELSE PRINT " No"; 10100 PROC_WAIT(150) 10110 IF YES THEN PROC_INSTRUCT 10120 ENDPROC 10130 :::::::::::::::::::::::::::::::::: 10200 DEF PROC_WAIT(T) 10210 LOCAL NOW 10220 NOW=TIME 10230 REPEAT 10240 UNTIL TIME=NOW+T 10250 ENDPROC 10260 :::::::::::::::::::::::::::::::::: 10300 DEF PROC_YN 10310 *FX21,0 10320 LOCAL G 10330 REPEAT 10340 G=GET 10350 G=G+32*(G>95): REM CONVERT TO CAPIT ALS 10360 YES=(G=89) 10370 NO=(G=78) 10380 UNTIL YES OR NO 10390 ENDPROC 10400 :::::::::::::::::::::::::::::::::: 10500 DEFPROC_SPACEBAR 10510 PRINT TAB(0,23)"Press SPACEBAR to con tinue"; 10520 LOCAL G 10530 *FX21,0 10540 REPEAT 10550 G=GET 10560 UNTIL G=32 10570 CLS 10580 ENDPROC 10590 :::::::::::::::::::::::::::::::::: 10600 DEF PROC_BYE 10610 CLS 10620 PRINT TAB(18,10)CHR$(141);"BYE" 10630 PRINT TAB(18,11)CHR$(141);"BYE" 10650 END 10660 :::::::::::::::::::::::::::::::::: 20000 DEF FN_CHAR(C$) 20010 LOCAL P,G$ 20020 REPEAT 20030 G$=GET$ 20040 P=INSTR(C$,G$) 20050 UNTIL P<>0 20060 PRINT G$; 20070 =P 20080 :::::::::::::::::::::::::::::::::: 20100 DEF FN_SHUFFLE(S$) 20110 LOCAL L,X,R1,R2,R1$,R2$ 20120 L=LEN(S$) 20130 FOR X=1 TO L 20140 R1=RND(L) 20150 R2=RND(L) 20160 R1$=MID$(S$,R1,1) 20170 R2$=MID$(S$,R2,1) 20180 S$=LEFT$(S$,R1-1)+R2$+MID$(S$,R1+1) 20190 S$=LEFT$(S$,R2-1)+R1$+MID$(S$,R2+1) 20200 NEXT X 20210 =S$ 20220 ::::::::::::::::::::::::::::::::::