Wordgram   (Model A)


Two versions of a very popular wordgame. Watch the letters move about the screen as you try to solve the JUMBLED game. The program allows you to select 'word endings' - a technique used frequently by crossword experts. You may also enter your own words for solution by someone else.

    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   ::::::::::::::::::::::::::::::::::