Tutorial 023 All-Mouse Hangman


Following the excercises in the previous two tutorials, you will now be able to see how the principles explained there and in previous tutorials can be combined in this our largest program to date, which I attempt to make  readable by the use of a number of explicitly named procedures.

When so described you can see that there is quite a lot of eventualities to be handled in the programming.

Text Listing for ease of pasting into the BB4W window

      REM: Richard Weston's Hangman, 25 April 2003 (50 years of DNA today!)
      MODE8:OFF
      :
      DIM word$(501),A$(20),B$(20),letter$(26),bx(26)
      PROCcountwords
      correct=0
      :
      PROCshufflewords
      :
      REM: ******** Game Loop **********
      FOR n= 1 TO nwords
        PRINTTAB(50,1)"Game  : ";n;" / ";nwords
        PRINTTAB(50,2)"Score : ";correct;" / ";n-1
        word$=word$(n)
        PROChangman
      NEXT n
      REM: *****************************
      END
      :
      :
      DEF PROChangman
      score=0
      initlives=11
      lives=initlives
      PROCtitle
      PROCalphabetsetup
      :
      PROCword_arrays
      :
      PROCkeys
      :
      IF n=1 THEN PROCinstruct
      :
      finished=FALSE
      REPEAT
        PROCmain
      UNTIL finished=TRUE
      :
      PROCend
      ENDPROC
      :
      DEF PROCinstruct
      caption$ = "How to play"
      message$ = "Click on the letter boxes"
      SYS "MessageBox", @hwnd%, message$, caption$, 64
      ENDPROC
      :
      DEF PROCmain
      PROClivesdisplay
      PROCdisplay
      PROCalphclick
      already=FALSE
      scored=FALSE
      FOR i= 1 TO L
        PROCtest(i)
      NEXT i
      IF scored=FALSE THEN
        lives-=1
        SOUND0,-15,3,1
      ENDIF
      :
      PROClivesdisplay
      PROCalphabstring
      PROCcheckfinished
      delay=INKEY(50)
      ENDPROC
      :
      DEF PROCcountwords
      REPEAT
        i=i+1
        READ word$(i)
      UNTIL word$(i)="*"
      nwords=i-1
      ENDPROC
      :
      DEF PROCshufflewords
      FOR i = nwords TO 2 STEP -1
        x=RND(i)
        temp$=word$(x)
        word$(x)=word$(i)
        word$(i)=temp$
      NEXT i
      ENDPROC
      :
      DEF PROCtitle
      COLOUR10
      PRINTTAB(3,1);"H M A N"
      PRINTTAB(3,2)"A     ["
      PRINTTAB(3,3)"N     ^"
      PRINTTAB(3,4)"G"
      ENDPROC
      :
      DEF PROCalphabetsetup
      alph$=""
      FOR i=1 TO 26
        letter$(i)=CHR$(96+i)
        alph$=alph$+letter$(i)+" "
      NEXT i
      COLOUR1
      PROCcentre(13,alph$)
      ENDPROC
      :
      DEFPROClivesdisplay
      c=lives
      IF c=8 THEN c=12
      IF c=1 THEN c=8
      COLOURc
      lives$=STRING$(lives,"<Life>")
      blank$=STRING$(66," ")
      PROCcentre(20,blank$)
      PROCcentre(20,lives$)
      ENDPROC
      :
      DEFPROCcentre(line,a$)
      len=LEN(a$)
      PRINTTAB(39-(len/2),line)a$
      ENDPROC
      :
      DEF PROCdisplay
      COLOUR15
      d$=""
      FOR i=1 TO L
        d$=d$+B$(i)+" "
      NEXT i
      PROCcentre(10,d$)
      ENDPROC
      :
      DEF PROCword_arrays
      L=LEN(word$)
      FOR i= 1 TO L
        A$(i)=MID$(word$,i,1)
        B$(i)="*"
      NEXT i
      ENDPROC
      :
      DEF PROCalphabstring
      FOR i=1 TO 26
        IF letter$(i)=G$ THEN
          letter$(i)="."
        ENDIF
      NEXT i
      alph$=""
      FOR j=1 TO 26
        alph$=alph$+letter$(j)+" "
      NEXT j
      COLOUR1
      blank$=STRING$(52," ")
      PROCcentre(13,blank$)
      PROCcentre(13,alph$)
      ENDPROC
      :
      DEF PROCend
      PROCdisplay
      COLOUR15
      PRINTTAB(30,24)"The word was ";word$
      COLOUR9
      PROCcentre(28,"Press <SPACE> for another word")
      G=GET
      CLS
      ENDPROC
      :
      DEF PROCbox(x,y,a,b)
      RECTANGLE x,y,a,b
      ENDPROC
      :
      DEF PROCmouse
      MOUSE x,y,btn
      FOR i=1 TO 26
        IF btn=4 THEN
          IF x>bx(i) THEN
            IF x<bx(i)+bw THEN
              IF y>by THEN
                IF y<by+bh THEN
                  G$=CHR$(96+i)
                  boxclicked=TRUE
                  SOUND1,-15,x/5.2,1
                ENDIF
              ENDIF
            ENDIF
          ENDIF
        ENDIF
      NEXT i
      ENDPROC
      :
      DEF PROCkeys
      by=500
      bw=30
      bh=30
      VDU5: REM print at graphics cursor
      FOR i=1 TO 26
        bx(i)=130+(35*i)
        PROCbox(bx(i),by,bw,bh)
        PLOT0,8,32
        PRINTCHR$(96+i)
      NEXT i
      VDU4
      ENDPROC
      :
      DEF PROCalphclick
      boxclicked=FALSE
      REPEAT
        PROCmouse
      UNTIL boxclicked
      ENDPROC
      :
      DEF PROCtest(i)
      IF B$(i)=G$ THEN already=TRUE:ENDPROC
      IF A$(i)=G$ THEN
        B$(i)=G$
        scored=TRUE
      ENDIF
      ENDPROC
      :
      DEF PROCcheckfinished
      LOCAL i
      IF lives=0 THEN finished=TRUE
      more_to_go=FALSE
      FOR i=1 TO L
        IF B$(i)="*" THEN
          more_to_go=TRUE
        ENDIF
      NEXT i
      IF NOT more_to_go THEN
        finished=TRUE
        correct+=1
        PRINTTAB(50,2)"Score : ";correct;" / ";n
      ENDIF
      ENDPROC
      :
      DATA phlegm, kayak, fjord, yummy, buxom, rhythm, cycle
      DATA jinx, quixotic, gnarled, glyph, gnostic, psyche, twelfths, fuchsia
      DATA banana, apple, carrot, aerial, parrot, gorilla, thistle, house
      DATA wrong, right, rabid, angry, comet, program, dictator, meteorite, rifle
      DATA computer, wrist, cranium, brain, nerve, spoof, sunshine, planet, satellite
      DATA soapy, green, yellow, elephant, haircut, scissors, mouse, photograph, scanner
      DATA aspirin, delight, happiness, victory, peace, femur, bliss, heaven, nirvana
      DATA ankle, kneecap, elbow, aardvark, abacus, enzyme, protein, nucleus, electron
      DATA positron, dinosaur, extinct, mantra, pigsty, temple, ziggurat, windmill
      DATA haddock, plaice, lobster, miniskirt, teacher, professor, diamond, zircon
      DATA criminal, judge, adjective, organ, violin, banjo, tempo, ballet, sextet
      DATA vocalist, clarinet, virtuoso, guitar, saxaphone, quartet, magician, spaniel
      DATA cabbage, broccoli, drought, tractor, haystack, telescope, asteroid, supernova
      DATA anchor,apple,food,fry,blast,dragon,pigeon,rhinoceros,seed,knock,jam,lesson
      DATA cold,hot,freezing,temperature,thermometer,doctor,pulse,stethoscope,coffin
      DATA undertake, heaven,hell,ice,sugar,cake,bake,yeast,bacterium,lozenge,fakir
      DATA knockabout,bellicose,angel,baccalaureate,babushka,bushbaby,cashew,dandelion
      DATA effervescence,future,laughable,diffident,miffed,gangling,gorgeous,happy
      DATA horrendous,hopping,shopping,popping,lopping,foggy,haha,gaga,saga,aga,baby
      DATA putrid,gangrenous,furniture,jejune,jealous,jinx,jaw,jew,jitters,jazzy,jab
      DATA kettle,key,kick,kill,kid,kilter,kind,lilly,leave,leg,kneecap,lentil,lethargy
      DATA malfunction,mummy,daddy,make,mammalian,mango,manners,market,maw,merry,mess,metabolism
      DATA metaphysics,metropolis,mezzanine,microcosm,micturition,middle,mimosa,miscellaneous
      DATA misnomer,mneme,mystery,new,natural,niggard,nightjar,nightingale,nincompoop,nocturnal
      DATA outrageous,often,quintessential,qualify,quadruped,quantify,quarter,quench,question
      DATA rural,rabid,radiate,rage,ragged,radius,rasp,retch,rascal,rapture,rapacious
      DATA rear,rebel,recess,reckon,recrudescence,recuperate,recycle,recluse,reeve,relapse
      DATA religious,remedy,remonstrate,replenish,reprieve,repudiate,retrograde,rhyme,ribbon
      DATA ridicule,ripple,rissole,rival,road,rollick,romp,rocket,rota,rubber,ruddy,rue
      DATA ruffle,rum,rung,rust,rye,ribaldry,saddle,saint,salary,salient,saliva,salmon
      DATA salvage,samaritan,sample,sanctuary,sapphire,sardine,sauerkraut,scallop,scapegoat
      DATA schism,schnorkel,scintilla,scimitar,science,scion,schnauzer,scroll,seamstress
      DATA secretary,solicitor,seminal,seraph,serious,sesspool,sew,shampoo,shovel,shrub
      DATA silence,skate,size,slim,smog,gargantuan,snigger,sociable,soldier,sonata
      DATA soot,soul,south,spatter,sparrow,spectacular,sphere,summon,syntax,sympathy
      DATA system,syphon,tacky,tender,tenement,tentacle,tenterhook,terminus,thaw,theatre
      DATA thorough, thought,three,throw,thumb,thymus,tiff,tiger,timorous,tintinabulation
      DATA titillate,tobacco,titanic,toff,tomahawk,tooth,tortoise,toxic,track,traffic,trail
      DATA transgress,triangle,trimaran,trophy,troubadour,trumpet,tuft,tumble,tuna,tungsten
      DATA tease,teetotal,telecommunication,tenacious,tercentenary,two,twelve,twitch,tyrant
      DATA tympanist,tyre,tsar,umbrage,unreasonable,upset,urn,upbraid,usher,use,vaccine
      DATA vulgar,vacant,valve,value,vampire,variety,variable,vandal,vein,ventilate
      DATA verify,vernacular,vest,viaduct,vicissitude,view,vigil,vindaloo,virus,vinegar
      DATA viscous,vitriol,vivid,vogue,voyage,wag,wail,wake,wallow,waltz,wander,wasp,wardrobe
      DATA wart,waterlogged,wattle,waxy,weather,whether,weed,weevil,weights,welter
      DATA whale,wheedle,wheeze,whelk,whinge,whip,whirl,whistle,whoop,whither,widow,wince,wink
      DATA wipe,wish,wizard,withdraw,wizened,wolf,wonder,work,world,worm,wound,writing,wring
      DATA wrought,wunderkind,wry,wrote,writing,xylophone,xenophobe,xylem,yacht,yam,yard,yarrow
      DATA yawn,year,yearn,yeast,yellow,yes,yew,yoghurt,yolk,young,youth,yowl,zap
      DATA zeal,zebra,zest,zombie,zonked,zoom,zymurgy,mollusc,malign,cuddle,cucumber,convolvulus
      :
      REM: Don't delete the following asterisk - its the end marker
      DATA *
Annotated Listing

      REM: Richard Weston's Hangman, 25 April 2003 (50 years of DNA today!)
      MODE8:OFF
      :
      DIM word$(501),A$(20),B$(20),letter$(26),bx(26) *** See later what theses do ***
      PROCcountwords
      correct=0
      :
      PROCshufflewords
      :
      REM: ******** Game Loop **********
      FOR n= 1 TO nwords *** nwords is the total number of words, presently 500 ***
        PRINTTAB(50,1)"Game  : ";n;" / ";nwords
        PRINTTAB(50,2)"Score : ";correct;" / ";n-1
        word$=word$(n)
        PROChangman **** defines one round of the game ***
      NEXT n
      REM: *****************************
      END
      :
      :
      DEF PROChangman
      score=0
      initlives=11 *** inititial lives 11 in the usual game ***
      lives=initlives *** lives goes down as you guess wrongly ***
      PROCtitle
      PROCalphabetsetup
      :
      PROCword_arrays
      :
      PROCkeys
      :
      IF n=1 THEN PROCinstruct  *** only needed on the first game ***
      :
      finished=FALSE
      REPEAT
        PROCmain *** Handles the mouse inputs and their consequences ***
      UNTIL finished=TRUE
      :
      PROCend
      ENDPROC
      :
      DEF PROCinstruct
      caption$ = "How to play"
      message$ = "Click on the letter boxes"
      SYS "MessageBox", @hwnd%, message$, caption$, 64 *** Option 64 gives the information symbol ***
      ENDPROC
      :
      DEF PROCmain
      PROClivesdisplay
      PROCdisplay
      PROCalphclick
      already=FALSE *** says whether a letter has already been guessed correctly ***
      scored=FALSE
      FOR i= 1 TO L *** L is the number of letters in the word, see below ***
        PROCtest(i)
      NEXT i
      IF scored=FALSE THEN
        lives-=1 *** lives-=1 is equivalent to lives=lives-1 ***
        SOUND0,-15,3,1 *** nasty noise ***
      ENDIF
      :
      PROClivesdisplay
      PROCalphabstring
      PROCcheckfinished
      delay=INKEY(50)
      ENDPROC
      :
      DEF PROCcountwords
      REPEAT
        i=i+1
        READ word$(i)
      UNTIL word$(i)="*"
      nwords=i-1 *** we don't want the asterisk (end marker) to be treated as a word
      ENDPROC
      :
      DEF PROCshufflewords *** our standard shuffle routine is almost instantaneous ***
      FOR i = nwords TO 2 STEP -1
        x=RND(i)
        temp$=word$(x)
        word$(x)=word$(i)
        word$(i)=temp$
      NEXT i
      ENDPROC
      :
      DEF PROCtitle *** Artistic? ***
      COLOUR10
      PRINTTAB(3,1);"H M A N"
      PRINTTAB(3,2)"A     ["
      PRINTTAB(3,3)"N     ^"
      PRINTTAB(3,4)"G"
      ENDPROC
      :
      DEF PROCalphabetsetup *** prints a full aphabet with a space after each letter ***
      alph$=""
      FOR i=1 TO 26 *** steps through the 26 letters of the alphabet ***
        letter$(i)=CHR$(96+i)
        alph$=alph$+letter$(i)+" "
      NEXT i
      COLOUR1
      PROCcentre(13,alph$)
      ENDPROC
      :
      DEFPROClivesdisplay ***
      c=lives
      IF c=8 THEN c=12
      IF c=1 THEN c=8
      COLOURc
      lives$=STRING$(lives,"<Life>")
      blank$=STRING$(66," ")
      PROCcentre(20,blank$) *** firsts wipes the previous lives display ***
      PROCcentre(20,lives$)
      ENDPROC
      :
      DEFPROCcentre(line,a$) *** centres the printed string  on the specified line going down the screen ***
      len=LEN(a$)
      PRINTTAB(39-(len/2),line)a$
      ENDPROC
      :
      DEF PROCdisplay ***
      COLOUR15
      d$="" *** display string null at first ***
      FOR i=1 TO L *** L is the length of the word, in letters - see PROCword_arrayas ***
        d$=d$+B$(i)+" "
      NEXT i
      PROCcentre(10,d$)
      ENDPROC
      :
      DEF PROCword_arrays
      L=LEN(word$) *** as used above ***
      FOR i= 1 TO L
        A$(i)=MID$(word$,i,1) *** extracts and stores the letters of the word in array A$ ***
        B$(i)="*"  *** initial mystery string of  asterisks for punters to guess at ***
      NEXT i
      ENDPROC
      :
      DEF PROCalphabstring *** alters the initial string of asterisks to include the correct letters guessed ***
      FOR i=1 TO 26
        IF letter$(i)=G$ THEN ***G$ is the guessed letter, see below ***
          letter$(i)="."
        ENDIF
      NEXT i
      alph$=""
      FOR j=1 TO 26
        alph$=alph$+letter$(j)+" "
      NEXT j
      COLOUR1
      blank$=STRING$(52," ")
      PROCcentre(13,blank$)
      PROCcentre(13,alph$)
      ENDPROC
      :
      DEF PROCend *** rounds off a game ***
      PROCdisplay
      COLOUR15
      PRINTTAB(30,24)"The word was ";word$
      COLOUR9
      PROCcentre(28,"Press <SPACE> for another word")
      G=GET
      CLS
      ENDPROC
      :
      DEF PROCbox(x,y,a,b) *** draws a  letter box ***
      RECTANGLE x,y,a,b
      ENDPROC
      :
      DEF PROCmouse
      MOUSE x,y,btn
      FOR i=1 TO 26
        IF btn=4 THEN *** left click ***
          IF x>bx(i) THEN
            IF x<bx(i)+bw THEN
              IF y>by THEN
                IF y<by+bh THEN *** if all true you have clicked letter box i ***
                  G$=CHR$(96+i) ***sets the guess letter's string, rather as a G$=GET$ from the keyboard would ***
                  boxclicked=TRUE
                  SOUND1,-15,x/5.2,1 *** Happyish Sound ***
                ENDIF
              ENDIF
            ENDIF
          ENDIF
        ENDIF
      NEXT i
      ENDPROC
      :
      DEF PROCkeys *** Prints the "keyboard"
      by=500 *** box's y position ***
      bw=30  *** box width ***
      bh=30    *** box height ***
      VDU5: REM print at graphics cursor
      FOR i=1 TO 26
        bx(i)=130+(35*i) *** done by experiment to spread out the keys appropriately ***
        PROCbox(bx(i),by,bw,bh)
        PLOT0,8,32
        PRINTCHR$(96+i) *** Puts the letter ij the keyboard box ***
      NEXT i
      VDU4 *** separate graphics and text cursors ***
      ENDPROC
      :
      DEF PROCalphclick *** handles clicks on the alphabet boxes ***
      boxclicked=FALSE
      REPEAT
        PROCmouse
      UNTIL boxclicked
      ENDPROC
      :
      DEF PROCtest(i) *** test each letter of the alphabet ***
      IF B$(i)=G$ THEN already=TRUE : ENDPROC *** Silly you had already clicked this box ***
      IF A$(i)=G$ THEN *** you've been shrewd/lucky ***
        B$(i)=G$ *** turns an asterisk into a correctly guessed letter ***
        scored=TRUE
      ENDIF
      ENDPROC
      :
      DEF PROCcheckfinished
      LOCAL i
      IF lives=0 THEN finished=TRUE
      more_to_go=FALSE
      FOR i=1 TO L *** steps along the letters of the word ***
        IF B$(i)="*" THEN
          more_to_go=TRUE *** you haven't guessed the word yet ***
        ENDIF
      NEXT i
      IF NOT more_to_go THEN
        finished=TRUE
        correct+=1
        PRINTTAB(50,2)"Score : ";correct;" / ";n
      ENDIF
      ENDPROC
      :
      DATA phlegm, kayak, fjord, yummy, buxom, rhythm, cycle
      DATA jinx, quixotic, gnarled, glyph, gnostic, psyche, twelfths, fuchsia
      DATA banana, apple, carrot, aerial, parrot, gorilla, thistle, house
      DATA wrong, right, rabid, angry, comet, program, dictator, meteorite, rifle
      DATA computer, wrist, cranium, brain, nerve, spoof, sunshine, planet, satellite
      DATA soapy, green, yellow, elephant, haircut, scissors, mouse, photograph, scanner
      DATA aspirin, delight, happiness, victory, peace, femur, bliss, heaven, nirvana
      DATA ankle, kneecap, elbow, aardvark, abacus, enzyme, protein, nucleus, electron
      DATA positron, dinosaur, extinct, mantra, pigsty, temple, ziggurat, windmill
      DATA haddock, plaice, lobster, miniskirt, teacher, professor, diamond, zircon
      DATA criminal, judge, adjective, organ, violin, banjo, tempo, ballet, sextet
      DATA vocalist, clarinet, virtuoso, guitar, saxaphone, quartet, magician, spaniel
      DATA cabbage, broccoli, drought, tractor, haystack, telescope, asteroid, supernova
      DATA anchor,apple,food,fry,blast,dragon,pigeon,rhinoceros,seed,knock,jam,lesson
      DATA cold,hot,freezing,temperature,thermometer,doctor,pulse,stethoscope,coffin
      DATA undertake, heaven,hell,ice,sugar,cake,bake,yeast,bacterium,lozenge,fakir
      DATA knockabout,bellicose,angel,baccalaureate,babushka,bushbaby,cashew,dandelion
      DATA effervescence,future,laughable,diffident,miffed,gangling,gorgeous,happy
      DATA horrendous,hopping,shopping,popping,lopping,foggy,haha,gaga,saga,aga,baby
      DATA putrid,gangrenous,furniture,jejune,jealous,jinx,jaw,jew,jitters,jazzy,jab
      DATA kettle,key,kick,kill,kid,kilter,kind,lilly,leave,leg,kneecap,lentil,lethargy
      DATA malfunction,mummy,daddy,make,mammalian,mango,manners,market,maw,merry,mess,metabolism
      DATA metaphysics,metropolis,mezzanine,microcosm,micturition,middle,mimosa,miscellaneous
      DATA misnomer,mneme,mystery,new,natural,niggard,nightjar,nightingale,nincompoop,nocturnal
      DATA outrageous,often,quintessential,qualify,quadruped,quantify,quarter,quench,question
      DATA rural,rabid,radiate,rage,ragged,radius,rasp,retch,rascal,rapture,rapacious
      DATA rear,rebel,recess,reckon,recrudescence,recuperate,recycle,recluse,reeve,relapse
      DATA religious,remedy,remonstrate,replenish,reprieve,repudiate,retrograde,rhyme,ribbon
      DATA ridicule,ripple,rissole,rival,road,rollick,romp,rocket,rota,rubber,ruddy,rue
      DATA ruffle,rum,rung,rust,rye,ribaldry,saddle,saint,salary,salient,saliva,salmon
      DATA salvage,samaritan,sample,sanctuary,sapphire,sardine,sauerkraut,scallop,scapegoat
      DATA schism,schnorkel,scintilla,scimitar,science,scion,schnauzer,scroll,seamstress
      DATA secretary,solicitor,seminal,seraph,serious,sesspool,sew,shampoo,shovel,shrub
      DATA silence,skate,size,slim,smog,gargantuan,snigger,sociable,soldier,sonata
      DATA soot,soul,south,spatter,sparrow,spectacular,sphere,summon,syntax,sympathy
      DATA system,syphon,tacky,tender,tenement,tentacle,tenterhook,terminus,thaw,theatre
      DATA thorough, thought,three,throw,thumb,thymus,tiff,tiger,timorous,tintinabulation
      DATA titillate,tobacco,titanic,toff,tomahawk,tooth,tortoise,toxic,track,traffic,trail
      DATA transgress,triangle,trimaran,trophy,troubadour,trumpet,tuft,tumble,tuna,tungsten
      DATA tease,teetotal,telecommunication,tenacious,tercentenary,two,twelve,twitch,tyrant
      DATA tympanist,tyre,tsar,umbrage,unreasonable,upset,urn,upbraid,usher,use,vaccine
      DATA vulgar,vacant,valve,value,vampire,variety,variable,vandal,vein,ventilate
      DATA verify,vernacular,vest,viaduct,vicissitude,view,vigil,vindaloo,virus,vinegar
      DATA viscous,vitriol,vivid,vogue,voyage,wag,wail,wake,wallow,waltz,wander,wasp,wardrobe
      DATA wart,waterlogged,wattle,waxy,weather,whether,weed,weevil,weights,welter
      DATA whale,wheedle,wheeze,whelk,whinge,whip,whirl,whistle,whoop,whither,widow,wince,wink
      DATA wipe,wish,wizard,withdraw,wizened,wolf,wonder,work,world,worm,wound,writing,wring
      DATA wrought,wunderkind,wry,wrote,writing,xylophone,xenophobe,xylem,yacht,yam,yard,yarrow
      DATA yawn,year,yearn,yeast,yellow,yes,yew,yoghurt,yolk,young,youth,yowl,zap
      DATA zeal,zebra,zest,zombie,zonked,zoom,zymurgy,mollusc,malign,cuddle,cucumber,convolvulus
      :
      REM: Don't delete the following asterisk - its the end marker
      DATA *

Next Tutorial

Richard Weston's Homepage