QB64.org Forum

Active Forums => Programs => Topic started by: bplus on June 15, 2019, 08:43:42 am

Title: Hangman
Post by: bplus on June 15, 2019, 08:43:42 am

Simple little game of Hangman:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Hangman 1" 'for QB64 B+ (redo Hang it) restarted 2019-06-14 for strip down version
3. DEFINT A-Z
4. CONST hung = "Hanged!" ' allows 7 misses
5. REDIM SHARED w$(1 TO 1), round, selectLetters$, nHung, done
6. DIM place, k$
7. LoadWords
8. DO ' main loop manages the letters to select from and removes letter when selected
9.     selectLetters$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
10.     nHung = 0: done = 0: IF round = 0 THEN round = 1
11.     CLS: Update
12.     WHILE done = 0
13.         k$ = ""
14.         WHILE LEN(k$) = 0: k$ = UCASE$(INKEY$): WEND
15.         place = INSTR(selectLetters$, k$)
16.         IF place THEN selectLetters$ = MID$(selectLetters$, 1, place - 1) + "-" + MID$(selectLetters$, place + 1)
17.         IF INSTR(w$(round), k$) = 0 THEN nHung = nHung + 1
18.         Update
19.     WEND
20. LOOP
21.  
22. FUNCTION Reveal$ ' from remaining selected letters a * will cover unchosen letters in w$(round)
23.     DIM i, b$
24.     FOR i = 1 TO LEN(w$(round))
25.         IF INSTR(selectLetters$, MID$(w$(round), i, 1)) > 0 THEN b$ = b$ + "*" ELSE b$ = b$ + MID$(w$(round), i, 1)
26.     NEXT
27.     Reveal$ = b$
28. END FUNCTION
29.  
30. SUB Update 'draw everything for screen 0 and while we're at it decide if word round is done
31.     cp 8, "Hangman: " + Reveal$
32.     cp 10, "Press a letter from: " + selectLetters$
33.     cp 12, "Gallows Report: " + MID$(hung, 1, nHung)
34.     IF Reveal$ = w$(round) THEN cp 14, "Congratulations! you got it.": done = -1
35.     IF LEN(hung) = nHung THEN cp 14, "Yikes! You were hung by: " + w$(round): done = -1
36.     IF done AND round + 1 > UBOUND(w$) THEN cp 16, "Hangman is out of words to play.": SLEEP: SYSTEM
37.     IF done AND round + 1 <= UBOUND(w$) THEN round = round + 1: cp 16, "Press any to continue...": SLEEP: _KEYCLEAR
38. END SUB
39.  
40. SUB cp (row, s$)
41.     LOCATE row, (80 - LEN(s$)) / 2: PRINT s$
42. END SUB
43.  
44. SUB LoadWords
45.     REDIM w$(1 TO 7)
46.     DIM i, s$
47.     FOR i = 1 TO 7: READ s$: w$(i) = UCASE$(s$): NEXT
48.     DATA "hangman","gallows","reveal","keypress","report","letters","basic"
49. END SUB
50.  

Title: Re: Hangman
Post by: bplus on June 15, 2019, 08:46:52 am

Hangman with mouse:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Hangman wMouse" ' B+  2019-06-14 from Hangman 1 and Letter Memory
3. DEFINT A-Z
4. TYPE XYtype
5.     X AS INTEGER
6.     Y AS INTEGER
7. END TYPE
8. TYPE LetterBox
9.     XY AS XYtype
10.     Show AS INTEGER ' 0, -1 revealed when matched, stay revealed
11.     Letter AS STRING '  letter to match
12. END TYPE
13. CONST xmax = 800, ymax = 400, boxSize = 50
14. CONST hung = "Hanged!" ' allows 7 misses
15. DIM SHARED LB(1 TO 26) AS LetterBox, round, Letters$, nHung, done
16. REDIM SHARED w$(1 TO 1) 'for redim to number of words in setUpGame
17. DIM place, k$, m, mb
18.  
19. SCREEN _NEWIMAGE(xmax, ymax, 32)
20. _SCREENMOVE 360, 60
21. SetUpGame
22. DO ' main loop manages the letters to select from and removes letter when selected
23.     Letters$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
24.     FOR place = 1 TO 26: LB(place).Show = -1: NEXT
25.     nHung = 0: done = 0: IF round = 0 THEN round = 1
26.     CLS: Update
27.     WHILE done = 0
28.         Update 'this handles the rest or the game
29.         k$ = UCASE$(INKEY$)
30.         IF LEN(k$) = 0 THEN k$ = getBoxLetter$
31.         IF LEN(k$) THEN
32.             place = INSTR(Letters$, k$)
33.             IF place THEN LB(place).Show = 0
34.             IF place THEN Letters$ = MID$(Letters$, 1, place - 1) + "-" + MID$(Letters$, place + 1)
35.             IF INSTR(w$(round), k$) = 0 THEN nHung = nHung + 1
36.         END IF
37.         IF done THEN Sleep2
38.         _LIMIT 60
39.     WEND
40. LOOP
41.  
42. FUNCTION getBoxLetter$
43.     DIM m, mx, my, mb, i
44.     WHILE _MOUSEINPUT: WEND
45.     mb = _MOUSEBUTTON(1) '            left button down
46.     IF mb THEN '                      get last place mouse button was down
47.         WHILE mb '                    wait for mouse button release as a "click"
48.             m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
49.         WEND
50.         FOR i = 1 TO 26 '             now find which box was clicked
51.             IF mx > LB(i).XY.X AND mx < LB(i).XY.X + boxSize THEN
52.                 IF my > LB(i).XY.Y AND my < LB(i).XY.Y + boxSize THEN
53.                     IF LB(i).Show THEN
54.                         getBoxLetter$ = CHR$(i + 64): EXIT FUNCTION
55.                     END IF
56.                 END IF
57.             END IF
58.         NEXT
59.     END IF
60. END FUNCTION
61.  
62. FUNCTION Reveal$ ' from remaining selected letters a * will cover unchosen letters in w$(round)
63.     DIM i, b$
64.     FOR i = 1 TO LEN(w$(round))
65.         IF INSTR(Letters$, MID$(w$(round), i, 1)) > 0 THEN
66.             b$ = b$ + "*"
67.         ELSE
68.             b$ = b$ + MID$(w$(round), i, 1)
69.         END IF
70.     NEXT
71.     Reveal$ = b$
72. END FUNCTION
73.  
74. SUB Update 'draw everything for screen 0 and while we're at it decide if word round is done
75.     DIM i, xoff, yoff, k$
76.     xoff = (boxSize - 8) / 2: yoff = (boxSize - 16) / 2 ' for letters in box
77.     FOR i = 1 TO 26
78.         LINE (LB(i).XY.X, LB(i).XY.Y)-STEP(boxSize, boxSize), &HFF000000, BF
79.         IF LB(i).Show <> 0 THEN
80.             LINE (LB(i).XY.X + 5, LB(i).XY.Y + 5)-STEP(boxSize - 10, boxSize - 10), &HFF0000BB, BF
81.             COLOR &HFFBBBBBB, &HFF0000BB
82.             _PRINTSTRING (LB(i).XY.X + xoff, LB(i).XY.Y + yoff), LB(i).Letter
83.         END IF
84.     NEXT
85.     COLOR &HFFBBBBBB, &HFF000000
86.     CP 2, "Hangman: " + Reveal$
87.     CP 4, "Press a letter from: " + Letters$
88.     CP 6, "Gallows Report: " + MID$(hung, 1, nHung)
89.     IF Reveal$ = w$(round) THEN CP 8, "Congratulations! you got it.": done = -1
90.     IF LEN(hung) = nHung THEN CP 10, "Yikes! You were hung by: " + w$(round): done = -1
91.     IF done AND round + 1 > UBOUND(w$) THEN
92.         CP 12, "Hangman is out of words to play.": _DISPLAY: _DELAY 3: END
93.     END IF
94.     IF done AND round + 1 <= UBOUND(w$) THEN round = round + 1: CP 12, "Click me or press any to continue..."
95.     _DISPLAY
96. END SUB
97.  
98. SUB CP (row, s$)
99.     LOCATE row, (100 - LEN(s$)) / 2: PRINT s$
100. END SUB
101.  
102. SUB Sleep2 'pause until keypress or mouseclick
103.     DIM k$
104.     DO
105.         k$ = INKEY$
106.         WHILE _MOUSEINPUT: WEND
107.         _LIMIT 30
108.     LOOP UNTIL LEN(k$) <> 0 OR _MOUSEBUTTON(1)
109.     _KEYCLEAR
110. END SUB
111.  
112. SUB SetUpGame
113.     DIM i, x, y, s$ 'for letter boxes there are 13 x 2 board and it is past 11 lines down screen
114.     REDIM w$(1 TO 7)
115.     CONST xoffset = INT((xmax - boxSize * 13) / 2)
116.     CONST yoffset = 11 * 16 + INT((ymax - boxSize * 2 - 11 * 16) / 2)
117.     FOR y = 1 TO 2 '                    set screen XY locations for Letter Boxes
118.         FOR x = 1 TO 13
119.             i = i + 1
120.             LB(i).XY.X = xoffset + (x - 1) * boxSize: LB(i).XY.Y = yoffset + (y - 1) * boxSize
121.             LB(i).Letter = CHR$(i + 64): LB(i).Show = -1
122.         NEXT
123.     NEXT
124.     FOR i = 1 TO 7
125.         READ s$
126.         w$(i) = UCASE$(s$)
127.     NEXT
128.     DATA "hangman","gallows","reveal","keypress","report","letters","basic"
129. END SUB
130.  

Title: Re: Hangman
Post by: bplus on June 15, 2019, 11:53:44 am

In case you'd like to get words from a word list file (also added escape to quit):

Just key press game:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Hangman 2 file loader" 'for QB64 B+ from Hangman 1.bas add file load  2019-06-15
3. DEFINT A-Z
4. CONST hung = "Hanged!" ' allows 7 misses
5. REDIM SHARED w$(1 TO 1), round, selectLetters$, nHung, done
6. DIM place, k$
7. LoadWords
8. DO ' main loop manages the letters to select from and removes letter when selected
9.     selectLetters$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
10.     nHung = 0: done = 0: IF round = 0 THEN round = 1
11.     CLS: Update
12.     WHILE done = 0
13.         k$ = ""
14.         WHILE LEN(k$) = 0: k$ = UCASE$(INKEY$): WEND
15.         IF ASC(k$) = 27 THEN SYSTEM 'escape the game
16.         place = INSTR(selectLetters$, k$)
17.         IF place THEN selectLetters$ = MID$(selectLetters$, 1, place - 1) + "-" + MID$(selectLetters$, place + 1)
18.         IF INSTR(w$(round), k$) = 0 THEN nHung = nHung + 1
19.         Update
20.     WEND
21. LOOP
22.  
23. FUNCTION Reveal$ ' from remaining selected letters a * will cover unchosen letters in w$(round)
24.     DIM i, b$
25.     FOR i = 1 TO LEN(w$(round))
26.         IF INSTR(selectLetters$, MID$(w$(round), i, 1)) > 0 THEN b$ = b$ + "*" ELSE b$ = b$ + MID$(w$(round), i, 1)
27.     NEXT
28.     Reveal$ = b$
29. END FUNCTION
30.  
31. SUB Update 'draw everything for screen 0 and while we're at it decide if word round is done
32.     cp 8, "Hangman: " + Reveal$
33.     cp 10, "Press a letter from: " + selectLetters$
34.     cp 12, "Gallows Report: " + MID$(hung, 1, nHung)
35.     IF Reveal$ = w$(round) THEN cp 14, "Congratulations! you got it.": done = -1
36.     IF LEN(hung) = nHung THEN cp 14, "Yikes! You were hung by: " + w$(round): done = -1
37.     IF done AND round + 1 > UBOUND(w$) THEN cp 16, "Hangman is out of words to play.": SLEEP: SYSTEM
38.     IF done AND round + 1 <= UBOUND(w$) THEN round = round + 1: cp 16, "Press any to continue...": SLEEP: _KEYCLEAR
39. END SUB
40.  
41. SUB cp (row, s$)
42.     LOCATE row, (80 - LEN(s$)) / 2: PRINT s$
43. END SUB
44.  
45. SUB LoadWords
46.     DIM i, s$, fileName$
47.     INPUT "If you would like to load words from a file, enter that name now > ", fileName$
48.     IF _FILEEXISTS(fileName$) THEN
49.         OPEN fileName$ FOR INPUT AS #1
50.         WHILE EOF(1) = 0
51.             INPUT #1, s$
52.             i = i + 1
53.             REDIM _PRESERVE w$(1 TO i)
54.             w$(i) = _TRIM$(UCASE$(s$))
55.         WEND
56.         CLOSE #1
57.         PRINT "Loaded"; i; "items from "; fileName$
58.         _TITLE "Hangman with Mouse, Word Source: " + fileName$
59.     ELSE
60.         PRINT "Loading default set of words..."
61.         REDIM w$(1 TO 7)
62.         FOR i = 1 TO 7: READ s$: w$(i) = UCASE$(s$): NEXT
63.         _TITLE "Hangman with Mouse, Word Source: default word list"
64.     END IF
65.     _DELAY 3
66.     DATA "hangman","gallows","reveal","keypress","report","letters","basic"
67. END SUB
68.  

Keypress and mouse game:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Hangman wMouse" ' B+  2019-06-15 update with load from file
3. DEFINT A-Z
4. TYPE XYtype
5.     X AS INTEGER
6.     Y AS INTEGER
7. END TYPE
8. TYPE LetterBox
9.     XY AS XYtype
10.     Show AS INTEGER ' 0, -1 revealed when matched, stay revealed
11.     Letter AS STRING '  letter to match
12. END TYPE
13. CONST xmax = 800, ymax = 400, boxSize = 50
14. CONST hung = "Hanged!" ' allows 7 misses
15. DIM SHARED LB(1 TO 26) AS LetterBox, round, Letters$, nHung, done
16. REDIM SHARED w$(1 TO 1) 'for redim to number of words in setUpGame
17. DIM place, k$
18.  
19. SCREEN _NEWIMAGE(xmax, ymax, 32)
20. _SCREENMOVE 360, 60
21. SetUpGame
22. DO ' main loop manages the letters to select from and removes letter when selected
23.     Letters$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
24.     FOR place = 1 TO 26: LB(place).Show = -1: NEXT
25.     nHung = 0: done = 0: IF round = 0 THEN round = 1
26.     CLS: Update
27.     WHILE done = 0
28.         Update 'this handles the rest or the game
29.         k$ = UCASE$(INKEY$)
30.         IF LEN(k$) = 0 THEN k$ = getBoxLetter$
31.         IF LEN(k$) THEN
32.             IF ASC(k$) = 27 THEN SYSTEM 'escape the game
33.             place = INSTR(Letters$, k$)
34.             IF place THEN LB(place).Show = 0
35.             IF place THEN Letters$ = MID$(Letters$, 1, place - 1) + "-" + MID$(Letters$, place + 1)
36.             IF INSTR(w$(round), k$) = 0 THEN nHung = nHung + 1
37.         END IF
38.         IF done THEN Sleep2
39.         _LIMIT 60
40.     WEND
41. LOOP
42.  
43. FUNCTION getBoxLetter$
44.     DIM m, mx, my, mb, i
45.     WHILE _MOUSEINPUT: WEND
46.     mb = _MOUSEBUTTON(1) '            left button down
47.     IF mb THEN '                      get last place mouse button was down
48.         WHILE mb '                    wait for mouse button release as a "click"
49.             m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
50.         WEND
51.         FOR i = 1 TO 26 '             now find which box was clicked
52.             IF mx > LB(i).XY.X AND mx < LB(i).XY.X + boxSize THEN
53.                 IF my > LB(i).XY.Y AND my < LB(i).XY.Y + boxSize THEN
54.                     IF LB(i).Show THEN
55.                         getBoxLetter$ = CHR$(i + 64): EXIT FUNCTION
56.                     END IF
57.                 END IF
58.             END IF
59.         NEXT
60.     END IF
61. END FUNCTION
62.  
63. FUNCTION Reveal$ ' from remaining selected letters a * will cover unchosen letters in w$(round)
64.     DIM i, b$
65.     FOR i = 1 TO LEN(w$(round))
66.         IF INSTR(Letters$, MID$(w$(round), i, 1)) > 0 THEN
67.             b$ = b$ + "*"
68.         ELSE
69.             b$ = b$ + MID$(w$(round), i, 1)
70.         END IF
71.     NEXT
72.     Reveal$ = b$
73. END FUNCTION
74.  
75. SUB Update 'draw everything for screen 0 and while we're at it decide if word round is done
76.     DIM i, xoff, yoff
77.     xoff = (boxSize - 8) / 2: yoff = (boxSize - 16) / 2 ' for letters in box
78.     FOR i = 1 TO 26
79.         LINE (LB(i).XY.X, LB(i).XY.Y)-STEP(boxSize, boxSize), &HFF000000, BF
80.         IF LB(i).Show <> 0 THEN
81.             LINE (LB(i).XY.X + 5, LB(i).XY.Y + 5)-STEP(boxSize - 10, boxSize - 10), &HFF0000BB, BF
82.             COLOR &HFFBBBBBB, &HFF0000BB
83.             _PRINTSTRING (LB(i).XY.X + xoff, LB(i).XY.Y + yoff), LB(i).Letter
84.         END IF
85.     NEXT
86.     COLOR &HFFBBBBBB, &HFF000000
87.     CP 2, "Hangman: " + Reveal$
88.     CP 4, "Press a letter from: " + Letters$
89.     CP 6, "Gallows Report: " + MID$(hung, 1, nHung)
90.     IF Reveal$ = w$(round) THEN CP 8, "Congratulations! you got it.": done = -1
91.     IF LEN(hung) = nHung THEN CP 10, "Yikes! You were hung by: " + w$(round): done = -1
92.     IF done AND round + 1 > UBOUND(w$) THEN
93.         CP 12, "Hangman is out of words to play.": _DISPLAY: _DELAY 3: END
94.     END IF
95.     IF done AND round + 1 <= UBOUND(w$) THEN round = round + 1: CP 12, "Click me or press any to continue..."
96.     _DISPLAY
97. END SUB
98.  
99. SUB CP (row, s$)
100.     LOCATE row, (100 - LEN(s$)) / 2: PRINT s$
101. END SUB
102.  
103. SUB Sleep2 'pause until keypress or mouseclick
104.     DIM k$
105.     DO
106.         k$ = INKEY$
107.         WHILE _MOUSEINPUT: WEND
108.         _LIMIT 30
109.     LOOP UNTIL LEN(k$) <> 0 OR _MOUSEBUTTON(1)
110.     _KEYCLEAR
111. END SUB
112.  
113. SUB SetUpGame
114.     DIM i, x, y 'for letter boxes there are 13 x 2 board and it is past 11 lines down screen
115.     REDIM w$(1 TO 7)
116.     CONST xoffset = INT((xmax - boxSize * 13) / 2)
117.     CONST yoffset = 11 * 16 + INT((ymax - boxSize * 2 - 11 * 16) / 2)
118.     FOR y = 1 TO 2 '                    set screen XY locations for Letter Boxes
119.         FOR x = 1 TO 13
120.             i = i + 1
121.             LB(i).XY.X = xoffset + (x - 1) * boxSize: LB(i).XY.Y = yoffset + (y - 1) * boxSize
122.             LB(i).Letter = CHR$(i + 64): LB(i).Show = -1
123.         NEXT
124.     NEXT
125.     LoadWords
126. END SUB
127.  
128. SUB LoadWords
129.     DIM i, s$, fileName$
130.     INPUT "If you would like to load words from a file, enter that name now > ", fileName$
131.     IF _FILEEXISTS(fileName$) THEN
132.         OPEN fileName$ FOR INPUT AS #1
133.         WHILE EOF(1) = 0
134.             INPUT #1, s$
135.             i = i + 1
136.             REDIM _PRESERVE w$(1 TO i)
137.             w$(i) = _TRIM$(UCASE$(s$))
138.         WEND
139.         CLOSE #1
140.         PRINT "Loaded"; i; "items from "; fileName$
141.         _TITLE "Hangman with Mouse, Word Source: " + fileName$
142.     ELSE
143.         PRINT "Loading default set of words..."
144.         REDIM w$(1 TO 7)
145.         FOR i = 1 TO 7: READ s$: w$(i) = UCASE$(s$): NEXT
146.         _TITLE "Hangman with Mouse, Word Source: default word list"
147.     END IF
148.     _DELAY 3
149.     DATA "hangman","gallows","reveal","keypress","report","letters","basic"
150. END SUB
151.  

Title: Re: Hangman
Post by: Ashish on June 16, 2019, 01:18:07 am

Hi! Nice work. At first, I didn't understood what type of program it is but soon, I understand that its a word guessing game.

Title: Re: Hangman
Post by: Ashish on June 16, 2019, 01:26:30 am

Hi Bplus, I want to say one more thing to you, In your "key press" and "key press & mouse" version of the game, the program respond to non-alphabetic characters also (like 1,2,ENTER KEY,BACKSPACE). I think app must be responded only to alphabetic keys.

Title: Re: Hangman
Post by: TempodiBasic on June 16, 2019, 06:16:10 am

Hi Bplus
very fine this letteral Hangman...
so much that I have ported it to my country!
So in the far away future in which QB64 will be open to the foreign (read like not english) languages it will works perfectly!

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Hangman 2 file loader" 'for QB64 B+ from Hangman 1.bas add file load  2019-06-15
3. DEFINT A-Z
4. CONST hung = "Hanged!", Accenti = "…Š¢£" ' allows 7 misses
5. REDIM SHARED w$(1 TO 1), round, selectLetters$, nHung, done
6. DIM place, k$
7. LoadWords
8. DO ' main loop manages the letters to select from and removes letter when selected
9.     selectLetters$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + Accenti
10.     nHung = 0: done = 0: IF round = 0 THEN round = 1
11.     CLS: Update
12.     WHILE done = 0
13.         k$ = ""
14.         WHILE LEN(k$) = 0: k$ = UCASE$(INKEY$): WEND
15.         IF ASC(k$) = 27 THEN SYSTEM 'escape the game
16.         place = INSTR(selectLetters$, k$)
17.         IF place THEN selectLetters$ = MID$(selectLetters$, 1, place - 1) + "-" + MID$(selectLetters$, place + 1)
18.         IF INSTR(w$(round), k$) = 0 THEN nHung = nHung + 1
19.         Update
20.     WEND
21. LOOP
22.  
23. FUNCTION Reveal$ ' from remaining selected letters a * will cover unchosen letters in w$(round)
24.     DIM i, b$
25.     FOR i = 1 TO LEN(w$(round))
26.         IF INSTR(selectLetters$, MID$(w$(round), i, 1)) > 0 THEN b$ = b$ + "*" ELSE b$ = b$ + MID$(w$(round), i, 1)
27.     NEXT
28.     Reveal$ = b$
29. END FUNCTION
30.  
31. SUB Update 'draw everything for screen 0 and while we're at it decide if word round is done
32.     cp 8, "Hangman: " + Reveal$
33.     cp 10, "Press a letter from: " + selectLetters$
34.     cp 12, "Gallows Report: " + MID$(hung, 1, nHung)
35.     IF Reveal$ = w$(round) THEN cp 14, "Congratulations! you got it.": done = -1
36.     IF LEN(hung) = nHung THEN cp 14, "Yikes! You were hung by: " + w$(round): done = -1
37.     IF done AND round + 1 > UBOUND(w$) THEN cp 16, "Hangman is out of words to play.": SLEEP: SYSTEM
38.     IF done AND round + 1 <= UBOUND(w$) THEN round = round + 1: cp 16, "Press any to continue...": SLEEP: _KEYCLEAR
39. END SUB
40.  
41. SUB cp (row, s$)
42.     LOCATE row, (80 - LEN(s$)) / 2: PRINT s$
43. END SUB
44.  
45. SUB LoadWords
46.     DIM i, s$, fileName$
47.     INPUT "If you would like to load words from a file, enter that name now > ", fileName$
48.     IF _FILEEXISTS(fileName$) THEN
49.         OPEN fileName$ FOR INPUT AS #1
50.         WHILE EOF(1) = 0
51.             INPUT #1, s$
52.             i = i + 1
53.             REDIM _PRESERVE w$(1 TO i)
54.             w$(i) = _TRIM$(UCASE$(s$))
55.         WEND
56.         CLOSE #1
57.         PRINT "Loaded"; i; "items from "; fileName$
58.         _TITLE "Hangman with Mouse, Word Source: " + fileName$
59.     ELSE
60.         PRINT "Loading default set of words..."
61.         REDIM w$(1 TO 7)
62.         FOR i = 1 TO 7: READ s$: w$(i) = UCASE$(s$): NEXT
63.         _TITLE "Hangman with Mouse, Word Source: default word list"
64.     END IF
65.     _DELAY 3
66.     DATA "partir•","canter…","rivel•","prover…","ripart","perchŠ","battŠ"
67.     DATA "hangman","gallows","reveal","keypress","report","letters","basic"
68. END SUB
69.  
70.  

Thanks to share

Title: Re: Hangman
Post by: bplus on June 16, 2019, 07:29:31 am

Thanks Ashish and TempodiBasic,

Hangman is a classic game from childhood, I never wondered what people from other countries might know about it. It is a fun way to get kids to practice spelling and learn some new words maybe (before computers anyway).

Ashish you are the 2nd person to suggest that pressing non letter keys (or letters already played also?) should not count against player. OK, a mod coming right up... stay tuned!

Title: Re: Hangman
Post by: bplus on June 16, 2019, 08:09:23 am

Key press version that only adds to HANGED! if the letter pressed is one from the select letters list displayed:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Hangman: keypress only with file loader" ' B+  2019-06-16 mod
3. DEFINT A-Z
4. CONST hung = "Hanged!" ' allows 7 misses
5. REDIM SHARED w$(1 TO 1), round, selectLetters$, nHung, done
6. DIM place, k$
7. LoadWords
8. DO ' main loop manages the letters to select from and removes letter when selected
9.     selectLetters$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
10.     nHung = 0: done = 0: IF round = 0 THEN round = 1
11.     CLS: Update
12.     WHILE done = 0
13.         DO
14.             k$ = "": WHILE LEN(k$) = 0: k$ = INKEY$: _LIMIT 60: WEND
15.             k$ = UCASE$(k$)
16.         LOOP UNTIL INSTR(selectLetters$ + CHR$(27), k$) AND k$ <> " "
17.         IF ASC(k$) = 27 THEN SYSTEM 'escape the game
18.         place = INSTR(selectLetters$, k$)
19.         IF place THEN selectLetters$ = MID$(selectLetters$, 1, place - 1) + " " + MID$(selectLetters$, place + 1)
20.         IF INSTR(w$(round), k$) = 0 THEN nHung = nHung + 1
21.         Update
22.     WEND
23. LOOP
24.  
25. FUNCTION Reveal$ ' from remaining selected letters a * will cover unchosen letters in w$(round)
26.     DIM i, b$
27.     FOR i = 1 TO LEN(w$(round))
28.         IF INSTR(selectLetters$, MID$(w$(round), i, 1)) > 0 THEN b$ = b$ + "*" ELSE b$ = b$ + MID$(w$(round), i, 1)
29.     NEXT
30.     Reveal$ = b$
31. END FUNCTION
32.  
33. SUB Update 'draw everything for screen 0 and while we're at it decide if word round is done
34.     cp 8, "Hangman: " + Reveal$
35.     cp 10, "Press a letter from >>> " + selectLetters$
36.     cp 12, "Gallows Report: " + MID$(hung, 1, nHung)
37.     IF Reveal$ = w$(round) THEN cp 14, "Congratulations! you got it.": done = -1
38.     IF LEN(hung) = nHung THEN cp 14, "Yikes! You were hung by: " + w$(round): done = -1
39.     IF done AND round + 1 > UBOUND(w$) THEN cp 16, "Hangman is out of words to play.": SLEEP: SYSTEM
40.     IF done AND round + 1 <= UBOUND(w$) THEN round = round + 1: cp 16, "Press any to continue...": SLEEP: _KEYCLEAR
41. END SUB
42.  
43. SUB cp (row, s$)
44.     LOCATE row, (80 - LEN(s$)) / 2: PRINT s$
45. END SUB
46.  
47. SUB LoadWords
48.     DIM i, s$, fileName$
49.     INPUT "If you would like to load words from a file, enter that name now > ", fileName$
50.     IF _FILEEXISTS(fileName$) THEN
51.         OPEN fileName$ FOR INPUT AS #1
52.         WHILE EOF(1) = 0
53.             INPUT #1, s$
54.             i = i + 1
55.             REDIM _PRESERVE w$(1 TO i)
56.             w$(i) = _TRIM$(UCASE$(s$))
57.         WEND
58.         CLOSE #1
59.         PRINT "Loaded"; i; "items from "; fileName$
60.         _TITLE "Hangman with Mouse, Word Source: " + fileName$
61.     ELSE
62.         PRINT "Loading default set of words..."
63.         REDIM w$(1 TO 7)
64.         FOR i = 1 TO 7: READ s$: w$(i) = UCASE$(s$): NEXT
65.         _TITLE "Hangman: Keypress Only   Word Source: Default Word List"
66.     END IF
67.     _DELAY 2
68.     DATA "hangman","gallows","reveal","keypress","report","letters","basic"
69. END SUB
70.  

EDIT: I tried mouse only code and prefer having keys available as well, so now we have fix for non letter keys or repeating keys already played ie, does not count against you anymore.

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Hangman with Mouse and File Load" ' B+  2019-06-16 mouse only update with load from file
3. DEFINT A-Z
4. TYPE XYtype
5.     X AS INTEGER
6.     Y AS INTEGER
7. END TYPE
8. TYPE LetterBox
9.     XY AS XYtype
10.     Show AS INTEGER ' 0, -1 revealed when matched, stay revealed
11.     Letter AS STRING '  letter to match
12. END TYPE
13. CONST xmax = 800, ymax = 400, boxSize = 50
14. CONST hung = "Hanged!" ' allows 7 misses
15. DIM SHARED LB(1 TO 26) AS LetterBox, round, Letters$, nHung, done
16. REDIM SHARED w$(1 TO 1) 'for redim to number of words in setUpGame
17. DIM place, k$
18.  
19. SCREEN _NEWIMAGE(xmax, ymax, 32)
20. _SCREENMOVE 360, 60
21. SetUpGame
22. DO ' main loop manages the letters to select from and removes letter when selected
23.     Letters$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
24.     FOR place = 1 TO 26: LB(place).Show = -1: NEXT
25.     nHung = 0: done = 0: IF round = 0 THEN round = 1
26.     WHILE done = 0
27.         Update 'this handles the rest or the game
28.         k$ = UCASE$(INKEY$)
29.         IF LEN(k$) = 0 THEN k$ = getBoxLetter$
30.         IF LEN(k$) THEN
31.             IF ASC(k$) = 27 THEN SYSTEM 'escape the game
32.             place = INSTR(Letters$, k$)
33.             IF place AND k$ <> " " THEN
34.                 LB(place).Show = 0
35.                 Letters$ = MID$(Letters$, 1, place - 1) + " " + MID$(Letters$, place + 1)
36.                 IF INSTR(w$(round), k$) = 0 THEN nHung = nHung + 1
37.             END IF
38.         END IF
39.         IF done THEN Sleep2
40.         _LIMIT 60
41.     WEND
42. LOOP
43.  
44. FUNCTION getBoxLetter$
45.     DIM m, mx, my, mb, i
46.     WHILE _MOUSEINPUT: WEND
47.     mb = _MOUSEBUTTON(1) '            left button down
48.     IF mb THEN '                      get last place mouse button was down
49.         WHILE mb '                    wait for mouse button release as a "click"
50.             m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
51.         WEND
52.         FOR i = 1 TO 26 '             now find which box was clicked
53.             IF mx > LB(i).XY.X AND mx < LB(i).XY.X + boxSize THEN
54.                 IF my > LB(i).XY.Y AND my < LB(i).XY.Y + boxSize THEN
55.                     IF LB(i).Show THEN
56.                         getBoxLetter$ = CHR$(i + 64): EXIT FUNCTION
57.                     END IF
58.                 END IF
59.             END IF
60.         NEXT
61.     END IF
62. END FUNCTION
63.  
64. FUNCTION Reveal$ ' from remaining selected letters a * will cover unchosen letters in w$(round)
65.     DIM i, b$
66.     FOR i = 1 TO LEN(w$(round))
67.         IF INSTR(Letters$, MID$(w$(round), i, 1)) > 0 THEN
68.             b$ = b$ + "*"
69.         ELSE
70.             b$ = b$ + MID$(w$(round), i, 1)
71.         END IF
72.     NEXT
73.     Reveal$ = b$
74. END FUNCTION
75.  
76. SUB Update 'draw everything for screen 0 and while we're at it decide if word round is done
77.     DIM i, xoff, yoff
78.     CLS
79.     xoff = (boxSize - 8) / 2: yoff = (boxSize - 16) / 2 ' for letters in box
80.     FOR i = 1 TO 26
81.         LINE (LB(i).XY.X, LB(i).XY.Y)-STEP(boxSize, boxSize), &HFF000000, BF
82.         IF LB(i).Show <> 0 THEN
83.             LINE (LB(i).XY.X + 5, LB(i).XY.Y + 5)-STEP(boxSize - 10, boxSize - 10), &HFF0000BB, BF
84.             COLOR &HFFBBBBBB, &HFF0000BB
85.             _PRINTSTRING (LB(i).XY.X + xoff, LB(i).XY.Y + yoff), LB(i).Letter
86.         END IF
87.     NEXT
88.     COLOR &HFFBBBBBB, &HFF000000
89.     CP 2, "Hangman: " + Reveal$
90.     CP 4, "Press a letter from: " + Letters$
91.     CP 6, "Gallows Report: " + MID$(hung, 1, nHung)
92.     IF Reveal$ = w$(round) THEN CP 8, "Congratulations! you got it.": done = -1
93.     IF LEN(hung) = nHung THEN CP 10, "Yikes! You were hung by: " + w$(round): done = -1
94.     IF done AND round + 1 > UBOUND(w$) THEN
95.         CP 12, "Hangman is out of words to play.": _DISPLAY: _DELAY 3: END
96.     END IF
97.     IF done AND round + 1 <= UBOUND(w$) THEN round = round + 1: CP 12, "Click me or press any to continue..."
98.     _DISPLAY
99. END SUB
100.  
101. SUB CP (row, s$)
102.     LOCATE row, (100 - LEN(s$)) / 2: PRINT s$
103. END SUB
104.  
105. SUB Sleep2 'pause until keypress or mouseclick
106.     DIM k$
107.     DO
108.         k$ = INKEY$
109.         WHILE _MOUSEINPUT: WEND
110.         _LIMIT 30
111.     LOOP UNTIL LEN(k$) <> 0 OR _MOUSEBUTTON(1)
112.     _KEYCLEAR
113. END SUB
114.  
115. SUB SetUpGame
116.     DIM i, x, y 'for letter boxes there are 13 x 2 board and it is past 11 lines down screen
117.     REDIM w$(1 TO 7)
118.     CONST xoffset = INT((xmax - boxSize * 13) / 2)
119.     CONST yoffset = 11 * 16 + INT((ymax - boxSize * 2 - 11 * 16) / 2)
120.     FOR y = 1 TO 2 '                    set screen XY locations for Letter Boxes
121.         FOR x = 1 TO 13
122.             i = i + 1
123.             LB(i).XY.X = xoffset + (x - 1) * boxSize: LB(i).XY.Y = yoffset + (y - 1) * boxSize
124.             LB(i).Letter = CHR$(i + 64): LB(i).Show = -1
125.         NEXT
126.     NEXT
127.     LoadWords
128. END SUB
129.  
130. SUB LoadWords
131.     DIM i, s$, fileName$
132.     INPUT "If you would like to load words from a file, enter that name now > ", fileName$
133.     IF _FILEEXISTS(fileName$) THEN
134.         OPEN fileName$ FOR INPUT AS #1
135.         WHILE EOF(1) = 0
136.             INPUT #1, s$
137.             i = i + 1
138.             REDIM _PRESERVE w$(1 TO i)
139.             w$(i) = _TRIM$(UCASE$(s$))
140.         WEND
141.         CLOSE #1
142.         PRINT "Loaded"; i; "items from "; fileName$
143.         _TITLE "Hangman with Mouse, Word Source: " + fileName$
144.     ELSE
145.         PRINT "Loading default set of words..."
146.         REDIM w$(1 TO 7)
147.         FOR i = 1 TO 7: READ s$: w$(i) = UCASE$(s$): NEXT
148.         _TITLE "Hangman with Mouse, Word Source: default word list"
149.     END IF
150.     _DELAY 2
151.     DATA "hangman","gallows","reveal","keypress","report","letters","basic"
152. END SUB
153.  

Oh and here is some code for making Word Lists from some text you find loaded with words good for Hangman:
https://www.qb64.org/forum/index.php?topic=1426.0

Title: Re: Hangman
Post by: TempodiBasic on June 16, 2019, 12:09:48 pm

Hi Bplus

yes the game Hangman ,https://en.wikipedia.org/wiki/Hangman_(game) (https://en.wikipedia.org/wiki/Hangman_(game)), in my language Gioco dell'Impiccato, https://it.wikipedia.org/wiki/L%27impiccato (https://it.wikipedia.org/wiki/L%27impiccato), is a game learned at elementar school among schoolfriends.
In italian language it has no such educativ function because in my language there is one only connection between the sound and the sign with some little exceptions that are so easy to detect.
The words put as DATA in italian are one of these exception so that child student learn to distinguish the role of the accent on the final vocal letter of the word. So this is my IT mod... and if I'll have a little light of imagination I can workaround to let it works well also for accented words

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Hangman with Mouse and File Load" ' B+  2019-06-16 mouse only update with load from file
3. DEFINT A-Z
4. TYPE XYtype
5.     X AS INTEGER
6.     Y AS INTEGER
7. END TYPE
8. TYPE LetterBox
9.     XY AS XYtype
10.     Show AS INTEGER ' 0, -1 revealed when matched, stay revealed
11.     Letter AS STRING '  letter to match
12. END TYPE
13. CONST xmax = 800, ymax = 400, boxSize = 50
14. CONST hung = "Hanged!", Accenti = "…Š¢£" ' allows 7 misses
15. DIM SHARED LB(1 TO 26) AS LetterBox, round, Letters$, nHung, done
16. REDIM SHARED w$(1 TO 1) 'for redim to number of words in setUpGame
17. DIM place, k$
18.  
19. SCREEN _NEWIMAGE(xmax, ymax, 32)
20. _SCREENMOVE 360, 60
21. SetUpGame
22. DO ' main loop manages the letters to select from and removes letter when selected
23.     Letters$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + Accenti
24.     FOR place = 1 TO 26: LB(place).Show = -1: NEXT
25.     nHung = 0: done = 0: IF round = 0 THEN round = 1
26.     CLS: Update
27.     WHILE done = 0
28.         Update 'this handles the rest or the game
29.         k$ = getBoxLetter$
30.         IF LEN(k$) THEN
31.             IF ASC(k$) = 27 THEN SYSTEM 'escape the game
32.             place = INSTR(Letters$, k$)
33.             IF place THEN LB(place).Show = 0
34.             IF place THEN Letters$ = MID$(Letters$, 1, place - 1) + "-" + MID$(Letters$, place + 1)
35.             IF INSTR(w$(round), k$) = 0 THEN nHung = nHung + 1
36.         END IF
37.         IF done THEN Sleep2
38.         _LIMIT 60
39.     WEND
40. LOOP
41.  
42. FUNCTION getBoxLetter$
43.     DIM m, mx, my, mb, i
44.     WHILE _MOUSEINPUT: WEND
45.     mb = _MOUSEBUTTON(1) '            left button down
46.     IF mb THEN '                      get last place mouse button was down
47.         WHILE mb '                    wait for mouse button release as a "click"
48.             m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
49.         WEND
50.         FOR i = 1 TO 26 '             now find which box was clicked
51.             IF mx > LB(i).XY.X AND mx < LB(i).XY.X + boxSize THEN
52.                 IF my > LB(i).XY.Y AND my < LB(i).XY.Y + boxSize THEN
53.                     IF LB(i).Show THEN
54.                         getBoxLetter$ = CHR$(i + 64): EXIT FUNCTION
55.                     END IF
56.                 END IF
57.             END IF
58.         NEXT
59.     END IF
60. END FUNCTION
61.  
62. FUNCTION Reveal$ ' from remaining selected letters a * will cover unchosen letters in w$(round)
63.     DIM i, b$
64.     FOR i = 1 TO LEN(w$(round))
65.         IF INSTR(Letters$, MID$(w$(round), i, 1)) > 0 THEN
66.             b$ = b$ + "*"
67.         ELSE
68.             b$ = b$ + MID$(w$(round), i, 1)
69.         END IF
70.     NEXT
71.     Reveal$ = b$
72. END FUNCTION
73.  
74. SUB Update 'draw everything for screen 0 and while we're at it decide if word round is done
75.     DIM i, xoff, yoff
76.     xoff = (boxSize - 8) / 2: yoff = (boxSize - 16) / 2 ' for letters in box
77.     FOR i = 1 TO 26
78.         LINE (LB(i).XY.X, LB(i).XY.Y)-STEP(boxSize, boxSize), &HFF000000, BF
79.         IF LB(i).Show <> 0 THEN
80.             LINE (LB(i).XY.X + 5, LB(i).XY.Y + 5)-STEP(boxSize - 10, boxSize - 10), &HFF0000BB, BF
81.             COLOR &HFFBBBBBB, &HFF0000BB
82.             _PRINTSTRING (LB(i).XY.X + xoff, LB(i).XY.Y + yoff), LB(i).Letter
83.         END IF
84.     NEXT
85.     COLOR &HFFBBBBBB, &HFF000000
86.     CP 2, "Hangman: " + Reveal$
87.     CP 4, "Press a letter from: " + Letters$
88.     CP 6, "Gallows Report: " + MID$(hung, 1, nHung)
89.     IF Reveal$ = w$(round) THEN CP 8, "Congratulations! you got it.": done = -1
90.     IF LEN(hung) = nHung THEN CP 10, "Yikes! You were hung by: " + w$(round): done = -1
91.     IF done AND round + 1 > UBOUND(w$) THEN
92.         CP 12, "Hangman is out of words to play.": _DISPLAY: _DELAY 3: END
93.     END IF
94.     IF done AND round + 1 <= UBOUND(w$) THEN round = round + 1: CP 12, "Click me or press any to continue..."
95.     _DISPLAY
96. END SUB
97.  
98. SUB CP (row, s$)
99.     LOCATE row, (100 - LEN(s$)) / 2: PRINT s$
100. END SUB
101.  
102. SUB Sleep2 'pause until keypress or mouseclick
103.     DIM k$
104.     DO
105.         k$ = INKEY$
106.         WHILE _MOUSEINPUT: WEND
107.         _LIMIT 30
108.     LOOP UNTIL LEN(k$) <> 0 OR _MOUSEBUTTON(1)
109.     _KEYCLEAR
110. END SUB
111.  
112. SUB SetUpGame
113.     DIM i, x, y 'for letter boxes there are 13 x 2 board and it is past 11 lines down screen
114.     REDIM w$(1 TO 7)
115.     CONST xoffset = INT((xmax - boxSize * 13) / 2)
116.     CONST yoffset = 11 * 16 + INT((ymax - boxSize * 2 - 11 * 16) / 2)
117.     FOR y = 1 TO 2 '                    set screen XY locations for Letter Boxes
118.         FOR x = 1 TO 13
119.             i = i + 1
120.             LB(i).XY.X = xoffset + (x - 1) * boxSize: LB(i).XY.Y = yoffset + (y - 1) * boxSize
121.             LB(i).Letter = CHR$(i + 64): LB(i).Show = -1
122.         NEXT
123.     NEXT
124.     LoadWords
125. END SUB
126.  
127. SUB LoadWords
128.     DIM i, s$, fileName$
129.     INPUT "If you would like to load words from a file, enter that name now > ", fileName$
130.     IF _FILEEXISTS(fileName$) THEN
131.         OPEN fileName$ FOR INPUT AS #1
132.         WHILE EOF(1) = 0
133.             INPUT #1, s$
134.             i = i + 1
135.             REDIM _PRESERVE w$(1 TO i)
136.             w$(i) = _TRIM$(UCASE$(s$))
137.         WEND
138.         CLOSE #1
139.         PRINT "Loaded"; i; "items from "; fileName$
140.         _TITLE "Hangman with Mouse, Word Source: " + fileName$
141.     ELSE
142.         PRINT "Loading default set of words..."
143.         REDIM w$(1 TO 7)
144.         FOR i = 1 TO 7: READ s$: w$(i) = UCASE$(s$): NEXT
145.         _TITLE "Hangman with Mouse, Word Source: default word list"
146.     END IF
147.     _DELAY 2
148.     DATA "partir•","canter…","rivel•","prover…","ripart","perchŠ","battŠ"
149.     DATA "hangman","gallows","reveal","keypress","report","letters","basic"
150. END SUB
151.  

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Thanks to share

Title: Re: Hangman
Post by: bplus on June 16, 2019, 12:31:04 pm

Hi TempodiBasic,

Do you want help adding letter boxes for accents?
(assuming these are like more letters and not like you could add accent to any letter)

Title: Re: Hangman
Post by: TempodiBasic on June 16, 2019, 05:42:30 pm

Hi Bplus
Yes I find very cool the way of a Hanging Message at the place of a picture so I go on with the IT mod

As first attempt I have tried to make a box for accent like the CapsLock key of keyboard to use as first choice in a combo choice to input accented vocals.... but I loose my immagination into the path of flags to manage the output as boxes avaiable to select by mouse, while it works well both to show letters founded, both to show letters that user can still choice.

So at the end I got the working mod adding the 5 boxes for accented vocals (expanding the boxes to select by mouse)

here code

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Hangman with Mouse and File Load" ' B+  2019-06-16 mouse only update with load from file
3. DEFINT A-Z
4. TYPE XYtype
5.     X AS INTEGER
6.     Y AS INTEGER
7. END TYPE
8. TYPE LetterBox
9.     XY AS XYtype
10.     Show AS INTEGER ' 0, -1 revealed when matched, stay revealed
11.     Letter AS STRING '  letter to match
12. END TYPE
13. CONST xmax = 800, ymax = 400, boxSize = 50
14. CONST hung = "Hanged!", Accenti = "…Š¢£" ' allows 7 misses
15. DIM SHARED LB(1 TO 31) AS LetterBox, round, Letters$, nHung, done
16. REDIM SHARED w$(1 TO 1) 'for redim to number of words in setUpGame
17. DIM place, k$
18.  
19.  
20. SCREEN _NEWIMAGE(xmax, ymax, 32)
21. _SCREENMOVE 360, 60
22. SetUpGame
23. DO ' main loop manages the letters to select from and removes letter when selected
24.     Letters$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + Accenti
25.     FOR place = 1 TO 31: LB(place).Show = -1: NEXT
26.     nHung = 0: done = 0: IF round = 0 THEN round = 1
27.     CLS: Update
28.     WHILE done = 0
29.         Update 'this handles the rest or the game
30.         k$ = getBoxLetter$
31.         IF LEN(k$) THEN
32.             IF ASC(k$) = 27 THEN SYSTEM 'escape the game
33.             place = INSTR(Letters$, k$)
34.             IF place THEN LB(place).Show = 0
35.             IF place THEN Letters$ = MID$(Letters$, 1, place - 1) + "-" + MID$(Letters$, place + 1)
36.             IF INSTR(w$(round), k$) = 0 THEN nHung = nHung + 1
37.         END IF
38.         IF done THEN Sleep2
39.         _LIMIT 60
40.     WEND
41. LOOP
42.  
43. FUNCTION getBoxLetter$
44.     DIM m, mx, my, mb, i
45.     WHILE _MOUSEINPUT: WEND
46.     mb = _MOUSEBUTTON(1) '            left button down
47.     IF mb THEN '                      get last place mouse button was down
48.         WHILE mb '                    wait for mouse button release as a "click"
49.             m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
50.         WEND
51.         FOR i = 1 TO 31 '             now find which box was clicked
52.             IF mx > LB(i).XY.X AND mx < LB(i).XY.X + boxSize THEN
53.                 IF my > LB(i).XY.Y AND my < LB(i).XY.Y + boxSize THEN
54.                     IF LB(i).Show THEN
55.                         IF i < 27 THEN
56.                             getBoxLetter$ = CHR$(i + 64)
57.                         ELSEIF i > 26 THEN
58.                             getBoxLetter$ = MID$(Accenti, i - 26, 1)
59.                         END IF
60.                         EXIT FUNCTION
61.                     END IF
62.                 END IF
63.             END IF
64.         NEXT
65.     END IF
66. END FUNCTION
67.  
68. FUNCTION Reveal$ ' from remaining selected letters a * will cover unchosen letters in w$(round)
69.     DIM i, b$
70.     FOR i = 1 TO LEN(w$(round))
71.         IF INSTR(Letters$, MID$(w$(round), i, 1)) > 0 THEN
72.             b$ = b$ + "*"
73.         ELSE
74.             b$ = b$ + MID$(w$(round), i, 1)
75.         END IF
76.     NEXT
77.     Reveal$ = b$
78. END FUNCTION
79.  
80. SUB Update 'draw everything for screen 0 and while we're at it decide if word round is done
81.     DIM i, xoff, yoff
82.     xoff = (boxSize - 8) / 2: yoff = (boxSize - 16) / 2 ' for letters in box
83.     FOR i = 1 TO 31
84.         LINE (LB(i).XY.X, LB(i).XY.Y)-STEP(boxSize, boxSize), &HFF000000, BF
85.         IF LB(i).Show <> 0 THEN
86.             LINE (LB(i).XY.X + 5, LB(i).XY.Y + 5)-STEP(boxSize - 10, boxSize - 10), &HFF0000BB, BF
87.             COLOR &HFFBBBBBB, &HFF0000BB
88.             _PRINTSTRING (LB(i).XY.X + xoff, LB(i).XY.Y + yoff), LB(i).Letter
89.         END IF
90.     NEXT
91.     COLOR &HFFBBBBBB, &HFF000000
92.     CP 2, "Hangman: " + Reveal$
93.     CP 4, "Press a letter from: " + Letters$
94.     CP 6, "Gallows Report: " + MID$(hung, 1, nHung)
95.     IF Reveal$ = w$(round) THEN CP 8, "Congratulations! you got it.": done = -1
96.     IF LEN(hung) = nHung THEN CP 10, "Yikes! You were hung by: " + w$(round): done = -1
97.     IF done AND round + 1 > UBOUND(w$) THEN
98.         CP 12, "Hangman is out of words to play.": _DISPLAY: _DELAY 3: END
99.     END IF
100.     IF done AND round + 1 <= UBOUND(w$) THEN round = round + 1: CP 12, "Click me or press any to continue..."
101.     _DISPLAY
102. END SUB
103.  
104. SUB CP (row, s$)
105.     LOCATE row, (100 - LEN(s$)) / 2: PRINT s$
106. END SUB
107.  
108. SUB Sleep2 'pause until keypress or mouseclick
109.     DIM k$
110.     DO
111.         k$ = INKEY$
112.         WHILE _MOUSEINPUT: WEND
113.         _LIMIT 30
114.     LOOP UNTIL LEN(k$) <> 0 OR _MOUSEBUTTON(1)
115.     _KEYCLEAR
116. END SUB
117.  
118. SUB SetUpGame
119.     DIM i, x, y 'for letter boxes there are 13 x 2 board and it is past 11 lines down screen
120.     REDIM w$(1 TO 7)
121.     CONST xoffset = INT((xmax - boxSize * 13) / 2)
122.     CONST yoffset = 11 * 16 + INT((ymax - boxSize * 2 - 11 * 16) / 2)
123.     FOR y = 1 TO 3 '                    set screen XY locations for Letter Boxes
124.         FOR x = 1 TO 13
125.             i = i + 1
126.             IF i = 32 THEN EXIT FOR
127.             LB(i).XY.X = xoffset + (x - 1) * boxSize: LB(i).XY.Y = yoffset + (y - 1) * boxSize
128.             IF i < 27 THEN
129.                 LB(i).Letter = CHR$(i + 64)
130.             ELSEIF i > 26 THEN
131.                 LB(i).Letter = MID$(Accenti, i - 26, 1)
132.             END IF
133.             LB(i).Show = -1
134.         NEXT
135.     NEXT
136.     LoadWords
137. END SUB
138.  
139. SUB LoadWords
140.     DIM i, s$, fileName$
141.     INPUT "If you would like to load words from a file, enter that name now > ", fileName$
142.     IF _FILEEXISTS(fileName$) THEN
143.         OPEN fileName$ FOR INPUT AS #1
144.         WHILE EOF(1) = 0
145.             INPUT #1, s$
146.             i = i + 1
147.             REDIM _PRESERVE w$(1 TO i)
148.             w$(i) = _TRIM$(UCASE$(s$))
149.         WEND
150.         CLOSE #1
151.         PRINT "Loaded"; i; "items from "; fileName$
152.         _TITLE "Hangman with Mouse, Word Source: " + fileName$
153.     ELSE
154.         PRINT "Loading default set of words..."
155.         REDIM w$(1 TO 7)
156.         FOR i = 1 TO 7: READ s$: w$(i) = UCASE$(s$): NEXT
157.         _TITLE "Hangman with Mouse, Word Source: default word list"
158.     END IF
159.     _DELAY 2
160.     DATA "partir¢","canter…","rivel¢","prover…","ripart","perchŠ","battŠ"
161.     DATA "hangman","gallows","reveal","keypress","report","letters","basic"
162. END SUB
163.  

and screenshot
  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Thanks Bplus

Title: Re: Hangman
Post by: bplus on June 16, 2019, 08:18:06 pm

Hi TempodiBasic,

So the accents work on all or some of the letters and they are not like additional letters? Yikes (if so), so what are all the combinations? There probably needs to be a key for each? (so you would't have to handle key combinations). For instance if I had to include both capital and lower case letters, I would probably show them all. Can you tell I don't know foreign languages? :)

Update: Oh! you do have it working nicely. I misunderstood, the accents do work like extra letters. I should have tried the code first before replying. Yes, I liked the Gallows report in text instead a graphics depiction also. I got that idea from a little NOOK app (NOOK is a book reading device sold by Barnes and Noble).


Thanks [banned user],

You know I've been thinking about a Wheel of Fortune variation myself. I think you would need other players to encourage getting the thing solved ASAP, otherwise you could have it solved but keep spinning to rack up points. There has to be some reward for getting it solved early specially if no threat of death by hanging :)

Title: Re: Hangman
Post by: TempodiBasic on June 18, 2019, 07:09:46 am

Hi Bplus

I have forgotten keyboard input so now it is working too...

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Hangman with Mouse and File Load" ' B+  2019-06-16 mouse only update with load from file
3. DEFINT A-Z
4. TYPE XYtype
5.     X AS INTEGER
6.     Y AS INTEGER
7. END TYPE
8. TYPE LetterBox
9.     XY AS XYtype
10.     Show AS INTEGER ' 0, -1 revealed when matched, stay revealed
11.     Letter AS STRING '  letter to match
12. END TYPE
13. CONST xmax = 800, ymax = 400, boxSize = 50
14. CONST hung = "Hanged!", Accenti = "…Š¢£" ' allows 7 misses
15. DIM SHARED LB(1 TO 31) AS LetterBox, round, Letters$, nHung, done
16. REDIM SHARED w$(1 TO 1) 'for redim to number of words in setUpGame
17. DIM place, k$
18.  
19.  
20. SCREEN _NEWIMAGE(xmax, ymax, 32)
21. _SCREENMOVE 360, 60
22. SetUpGame
23. DO ' main loop manages the letters to select from and removes letter when selected
24.     Letters$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + Accenti
25.     FOR place = 1 TO 31: LB(place).Show = -1: NEXT
26.     nHung = 0: done = 0: IF round = 0 THEN round = 1
27.     CLS: Update
28.     WHILE done = 0
29.         Update 'this handles the rest or the game
30.         k$ = getBoxLetter$
31.         IF LEN(k$) THEN
32.             IF ASC(k$) = 27 THEN SYSTEM 'escape the game
33.             place = INSTR(Letters$, k$)
34.             IF place THEN LB(place).Show = 0
35.             IF place THEN Letters$ = MID$(Letters$, 1, place - 1) + "-" + MID$(Letters$, place + 1)
36.             IF INSTR(w$(round), k$) = 0 THEN nHung = nHung + 1
37.         END IF
38.         IF done THEN Sleep2
39.         _LIMIT 60
40.     WEND
41. LOOP
42.  
43. FUNCTION getBoxLetter$
44.     DIM m, mx, my, mb, i, K$
45.     DO
46.         K$ = UCASE$(INKEY$)
47.         WHILE _MOUSEINPUT: WEND
48.     LOOP UNTIL LEN(K$) <> 0 OR _MOUSEBUTTON(1)
49.     mb = _MOUSEBUTTON(1) '            left button down
50.     IF mb THEN '                      get last place mouse button was down
51.         WHILE mb '                    wait for mouse button release as a "click"
52.             m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
53.         WEND
54.         FOR i = 1 TO 31 '             now find which box was clicked
55.             IF mx > LB(i).XY.X AND mx < LB(i).XY.X + boxSize THEN
56.                 IF my > LB(i).XY.Y AND my < LB(i).XY.Y + boxSize THEN
57.                     IF LB(i).Show THEN
58.                         IF i < 27 THEN
59.                             getBoxLetter$ = CHR$(i + 64)
60.                         ELSEIF i > 26 THEN
61.                             getBoxLetter$ = MID$(Accenti, i - 26, 1)
62.                         END IF
63.                         EXIT FUNCTION
64.                     END IF
65.                 END IF
66.             END IF
67.         NEXT
68.     END IF
69.     'àèìòù  =     …Š¢£
70.     IF (ASC(K$) > 64 AND ASC(K$) < 91) THEN
71.         getBoxLetter$ = K$
72.         EXIT FUNCTION
73.     ELSEIF K$ = "à" THEN
74.         getBoxLetter$ = "…"
75.         EXIT FUNCTION
76.     ELSEIF K$ = "è" THEN
77.         getBoxLetter$ = "Š"
78.         EXIT FUNCTION
79.     ELSEIF K$ = "ì" THEN
80.         getBoxLetter$ = ""
81.         EXIT FUNCTION
82.     ELSEIF K$ = "ò" THEN
83.         getBoxLetter$ = "¢"
84.         EXIT FUNCTION
85.     ELSEIF K$ = "ù" THEN
86.         getBoxLetter$ = "£"
87.         EXIT FUNCTION
88.     END IF
89. END FUNCTION
90.  
91. FUNCTION Reveal$ ' from remaining selected letters a * will cover unchosen letters in w$(round)
92.     DIM i, b$
93.     FOR i = 1 TO LEN(w$(round))
94.         IF INSTR(Letters$, MID$(w$(round), i, 1)) > 0 THEN
95.             b$ = b$ + "*"
96.         ELSE
97.             b$ = b$ + MID$(w$(round), i, 1)
98.         END IF
99.     NEXT
100.     Reveal$ = b$
101. END FUNCTION
102.  
103. SUB Update 'draw everything for screen 0 and while we're at it decide if word round is done
104.     DIM i, xoff, yoff
105.     xoff = (boxSize - 8) / 2: yoff = (boxSize - 16) / 2 ' for letters in box
106.     FOR i = 1 TO 31
107.         LINE (LB(i).XY.X, LB(i).XY.Y)-STEP(boxSize, boxSize), &HFF000000, BF
108.         IF LB(i).Show <> 0 THEN
109.             LINE (LB(i).XY.X + 5, LB(i).XY.Y + 5)-STEP(boxSize - 10, boxSize - 10), &HFF0000BB, BF
110.             COLOR &HFFBBBBBB, &HFF0000BB
111.             _PRINTSTRING (LB(i).XY.X + xoff, LB(i).XY.Y + yoff), LB(i).Letter
112.         END IF
113.     NEXT
114.     COLOR &HFFBBBBBB, &HFF000000
115.     CP 2, "Hangman: " + Reveal$
116.     CP 4, "Press a letter from: " + Letters$
117.     CP 6, "Gallows Report: " + MID$(hung, 1, nHung)
118.     IF Reveal$ = w$(round) THEN CP 8, "Congratulations! you got it.": done = -1
119.     IF LEN(hung) = nHung THEN CP 10, "Yikes! You were hung by: " + w$(round): done = -1
120.     IF done AND round + 1 > UBOUND(w$) THEN
121.         CP 12, "Hangman is out of words to play.": _DISPLAY: _DELAY 3: END
122.     END IF
123.     IF done AND round + 1 <= UBOUND(w$) THEN round = round + 1: CP 12, "Click me or press any to continue..."
124.     _DISPLAY
125. END SUB
126.  
127. SUB CP (row, s$)
128.     LOCATE row, (100 - LEN(s$)) / 2: PRINT s$
129. END SUB
130.  
131. SUB Sleep2 'pause until keypress or mouseclick
132.     DIM k$
133.     DO
134.         k$ = INKEY$
135.         WHILE _MOUSEINPUT: WEND
136.         _LIMIT 30
137.     LOOP UNTIL LEN(k$) <> 0 OR _MOUSEBUTTON(1)
138.     _KEYCLEAR
139. END SUB
140.  
141. SUB SetUpGame
142.     DIM i, x, y 'for letter boxes there are 13 x 2 board and it is past 11 lines down screen
143.     REDIM w$(1 TO 7)
144.     CONST xoffset = INT((xmax - boxSize * 13) / 2)
145.     CONST yoffset = 11 * 16 + INT((ymax - boxSize * 2 - 11 * 16) / 2)
146.     FOR y = 1 TO 3 '                    set screen XY locations for Letter Boxes
147.         FOR x = 1 TO 13
148.             i = i + 1
149.             IF i = 32 THEN EXIT FOR
150.             LB(i).XY.X = xoffset + (x - 1) * boxSize: LB(i).XY.Y = yoffset + (y - 1) * boxSize
151.             IF i < 27 THEN
152.                 LB(i).Letter = CHR$(i + 64)
153.             ELSEIF i > 26 THEN
154.                 LB(i).Letter = MID$(Accenti, i - 26, 1)
155.             END IF
156.             LB(i).Show = -1
157.         NEXT
158.     NEXT
159.     LoadWords
160. END SUB
161.  
162. SUB LoadWords
163.     DIM i, s$, fileName$
164.     INPUT "If you would like to load words from a file, enter that name now > ", fileName$
165.     IF _FILEEXISTS(fileName$) THEN
166.         OPEN fileName$ FOR INPUT AS #1
167.         WHILE EOF(1) = 0
168.             INPUT #1, s$
169.             i = i + 1
170.             REDIM _PRESERVE w$(1 TO i)
171.             w$(i) = _TRIM$(UCASE$(s$))
172.         WEND
173.         CLOSE #1
174.         PRINT "Loaded"; i; "items from "; fileName$
175.         _TITLE "Hangman with Mouse, Word Source: " + fileName$
176.     ELSE
177.         PRINT "Loading default set of words..."
178.         REDIM w$(1 TO 7)
179.         FOR i = 1 TO 7: READ s$: w$(i) = UCASE$(s$): NEXT
180.         _TITLE "Hangman with Mouse, Word Source: default word list"
181.     END IF
182.     _DELAY 2
183.     DATA "partir¢","canter…","rivel¢","prover…","ripart","perchŠ","battŠ"
184.     DATA "hangman","gallows","reveal","keypress","report","letters","basic"
185. END SUB
186.  
187.  

Thanks to sharing and trill my imagination!

Title: Re: Hangman
Post by: bplus on June 18, 2019, 10:28:32 am

Hi TempodiBasic,

I am testing your new code and run into an error when I click a box just cleared from screen. Line 70:

Code: QB64: [Select]

1. IF (ASC(K$) > 64 AND ASC(K$) < 91) THEN

ASC does not like K$ = "" so check that first before running the gauntlet.

Code: QB64: [Select]

1.     IF K$ <> "" THEN
2.         IF (ASC(K$) > 64 AND ASC(K$) < 91) THEN
3.             getBoxLetter$ = K$
4.             EXIT FUNCTION
5.         ELSEIF K$ = "à" THEN
6.             getBoxLetter$ = "…"
7.             EXIT FUNCTION
8.         ELSEIF K$ = "è" THEN
9.             getBoxLetter$ = "Š"
10.             EXIT FUNCTION
11.         ELSEIF K$ = "ì" THEN
12.             getBoxLetter$ = ""
13.             EXIT FUNCTION
14.         ELSEIF K$ = "ò" THEN
15.             getBoxLetter$ = "¢"
16.             EXIT FUNCTION
17.         ELSEIF K$ = "ù" THEN
18.             getBoxLetter$ = "£"
19.             EXIT FUNCTION
20.         END IF
21.     END IF
22.  

I thought there might be quicker way but I learn you have to translate key presses for the accent letters. But I don't think you need all the exit functions as you are headed out of the function already.

Oh and to fix Ashish critique, change:

Code: QB64: [Select]

1.             place = INSTR(Letters$, k$)
2.             IF place THEN LB(place).Show = 0
3.             IF place THEN Letters$ = MID$(Letters$, 1, place - 1) + "-" + MID$(Letters$, place + 1)
4.             IF INSTR(w$(round), k$) = 0 THEN nHung = nHung + 1
5.  

to this:

Code: QB64: [Select]

1.             place = INSTR(Letters$, k$)
2.             IF place AND k$ <> " " THEN
3.                 LB(place).Show = 0
4.                 Letters$ = MID$(Letters$, 1, place - 1) + " " + MID$(Letters$, place + 1)
5.                 IF INSTR(w$(round), k$) = 0 THEN nHung = nHung + 1
6.             END IF
7.  

So if a child is playing e won't get hanged! too soon if e accidentally repeats a bad letter already played.

Title: Re: Hangman
Post by: TempodiBasic on June 18, 2019, 06:30:40 pm

Hi Bplus
thanks for your time and your suggestions

here code following your correction

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Hangman with Mouse and File Load" ' B+  2019-06-16 mouse only update with load from file
3. DEFINT A-Z
4. TYPE XYtype
5.     X AS INTEGER
6.     Y AS INTEGER
7. END TYPE
8. TYPE LetterBox
9.     XY AS XYtype
10.     Show AS INTEGER ' 0, -1 revealed when matched, stay revealed
11.     Letter AS STRING '  letter to match
12. END TYPE
13. CONST xmax = 800, ymax = 400, boxSize = 50
14. CONST hung = "Hanged!", Accenti = "…Š¢£" ' allows 7 misses
15. DIM SHARED LB(1 TO 31) AS LetterBox, round, Letters$, nHung, done
16. REDIM SHARED w$(1 TO 1) 'for redim to number of words in setUpGame
17. DIM place, k$
18.  
19.  
20. SCREEN _NEWIMAGE(xmax, ymax, 32)
21. _SCREENMOVE 360, 60
22. SetUpGame
23. DO ' main loop manages the letters to select from and removes letter when selected
24.     Letters$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + Accenti
25.     FOR place = 1 TO 31: LB(place).Show = -1: NEXT
26.     nHung = 0: done = 0: IF round = 0 THEN round = 1
27.     CLS: Update
28.     WHILE done = 0
29.         Update 'this handles the rest or the game
30.         k$ = getBoxLetter$
31.         IF LEN(k$) THEN
32.             IF ASC(k$) = 27 THEN SYSTEM 'escape the game
33.             place = INSTR(Letters$, k$)
34.             IF place AND k$ <> " " THEN
35.                 LB(place).Show = 0
36.                 Letters$ = MID$(Letters$, 1, place - 1) + "-" + MID$(Letters$, place + 1)
37.                 IF INSTR(w$(round), k$) = 0 THEN nHung = nHung + 1
38.             END IF
39.             IF done THEN Sleep2
40.             _LIMIT 60
41.         END IF
42.     WEND
43. LOOP
44.  
45. FUNCTION getBoxLetter$
46.     DIM m, mx, my, mb, i, K$
47.     DO
48.         K$ = UCASE$(INKEY$)
49.         WHILE _MOUSEINPUT: WEND
50.     LOOP UNTIL LEN(K$) <> 0 OR _MOUSEBUTTON(1)
51.     mb = _MOUSEBUTTON(1) '            left button down
52.     IF mb THEN '                      get last place mouse button was down
53.         WHILE mb '                    wait for mouse button release as a "click"
54.             m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
55.         WEND
56.         FOR i = 1 TO 31 '             now find which box was clicked
57.             IF mx > LB(i).XY.X AND mx < LB(i).XY.X + boxSize THEN
58.                 IF my > LB(i).XY.Y AND my < LB(i).XY.Y + boxSize THEN
59.                     IF LB(i).Show THEN
60.                         IF i < 27 THEN
61.                             getBoxLetter$ = CHR$(i + 64)
62.                         ELSEIF i > 26 THEN
63.                             getBoxLetter$ = MID$(Accenti, i - 26, 1)
64.                         END IF
65.                         EXIT FUNCTION
66.                     END IF
67.                 END IF
68.             END IF
69.         NEXT
70.     END IF
71.     'àèìòù  =     …Š¢£
72.     IF NOT K$ = "" THEN
73.         IF (ASC(K$) > 64 AND ASC(K$) < 91) THEN
74.             getBoxLetter$ = K$
75.         ELSEIF K$ = "à" THEN
76.             getBoxLetter$ = "…"
77.         ELSEIF K$ = "è" THEN
78.             getBoxLetter$ = "Š"
79.         ELSEIF K$ = "ì" THEN
80.             getBoxLetter$ = ""
81.         ELSEIF K$ = "ò" THEN
82.             getBoxLetter$ = "¢"
83.         ELSEIF K$ = "ù" THEN
84.             getBoxLetter$ = "£"
85.         END IF
86.     END IF
87. END FUNCTION
88.  
89. FUNCTION Reveal$ ' from remaining selected letters a * will cover unchosen letters in w$(round)
90.     DIM i, b$
91.     FOR i = 1 TO LEN(w$(round))
92.         IF INSTR(Letters$, MID$(w$(round), i, 1)) > 0 THEN
93.             b$ = b$ + "*"
94.         ELSE
95.             b$ = b$ + MID$(w$(round), i, 1)
96.         END IF
97.     NEXT
98.     Reveal$ = b$
99. END FUNCTION
100.  
101. SUB Update 'draw everything for screen 0 and while we're at it decide if word round is done
102.     DIM i, xoff, yoff
103.     xoff = (boxSize - 8) / 2: yoff = (boxSize - 16) / 2 ' for letters in box
104.     FOR i = 1 TO 31
105.         LINE (LB(i).XY.X, LB(i).XY.Y)-STEP(boxSize, boxSize), &HFF000000, BF
106.         IF LB(i).Show <> 0 THEN
107.             LINE (LB(i).XY.X + 5, LB(i).XY.Y + 5)-STEP(boxSize - 10, boxSize - 10), &HFF0000BB, BF
108.             COLOR &HFFBBBBBB, &HFF0000BB
109.             _PRINTSTRING (LB(i).XY.X + xoff, LB(i).XY.Y + yoff), LB(i).Letter
110.         END IF
111.     NEXT
112.     COLOR &HFFBBBBBB, &HFF000000
113.     CP 2, "Hangman: " + Reveal$
114.     CP 4, "Press a letter from: " + Letters$
115.     CP 6, "Gallows Report: " + MID$(hung, 1, nHung)
116.     IF Reveal$ = w$(round) THEN CP 8, "Congratulations! you got it.": done = -1
117.     IF LEN(hung) = nHung THEN CP 10, "Yikes! You were hung by: " + w$(round): done = -1
118.     IF done AND round + 1 > UBOUND(w$) THEN
119.         CP 12, "Hangman is out of words to play.": _DISPLAY: _DELAY 3: END
120.     END IF
121.     IF done AND round + 1 <= UBOUND(w$) THEN round = round + 1: CP 12, "Click me or press any to continue..."
122.     _DISPLAY
123. END SUB
124.  
125. SUB CP (row, s$)
126.     LOCATE row, (100 - LEN(s$)) / 2: PRINT s$
127. END SUB
128.  
129. SUB Sleep2 'pause until keypress or mouseclick
130.     DIM k$
131.     DO
132.         k$ = INKEY$
133.         WHILE _MOUSEINPUT: WEND
134.         _LIMIT 30
135.     LOOP UNTIL LEN(k$) <> 0 OR _MOUSEBUTTON(1)
136.     _KEYCLEAR
137. END SUB
138.  
139. SUB SetUpGame
140.     DIM i, x, y 'for letter boxes there are 13 x 2 board and it is past 11 lines down screen
141.     REDIM w$(1 TO 7)
142.     CONST xoffset = INT((xmax - boxSize * 13) / 2)
143.     CONST yoffset = 11 * 16 + INT((ymax - boxSize * 2 - 11 * 16) / 2)
144.     FOR y = 1 TO 3 '                    set screen XY locations for Letter Boxes
145.         FOR x = 1 TO 13
146.             i = i + 1
147.             IF i = 32 THEN EXIT FOR
148.             LB(i).XY.X = xoffset + (x - 1) * boxSize: LB(i).XY.Y = yoffset + (y - 1) * boxSize
149.             IF i < 27 THEN
150.                 LB(i).Letter = CHR$(i + 64)
151.             ELSEIF i > 26 THEN
152.                 LB(i).Letter = MID$(Accenti, i - 26, 1)
153.             END IF
154.             LB(i).Show = -1
155.         NEXT
156.     NEXT
157.     LoadWords
158. END SUB
159.  
160. SUB LoadWords
161.     DIM i, s$, fileName$
162.     INPUT "If you would like to load words from a file, enter that name now > ", fileName$
163.     IF _FILEEXISTS(fileName$) THEN
164.         OPEN fileName$ FOR INPUT AS #1
165.         WHILE EOF(1) = 0
166.             INPUT #1, s$
167.             i = i + 1
168.             REDIM _PRESERVE w$(1 TO i)
169.             w$(i) = _TRIM$(UCASE$(s$))
170.         WEND
171.         CLOSE #1
172.         PRINT "Loaded"; i; "items from "; fileName$
173.         _TITLE "Hangman with Mouse, Word Source: " + fileName$
174.     ELSE
175.         PRINT "Loading default set of words..."
176.         REDIM w$(1 TO 7)
177.         FOR i = 1 TO 7: READ s$: w$(i) = UCASE$(s$): NEXT
178.         _TITLE "Hangman with Mouse, Word Source: default word list"
179.     END IF
180.     _DELAY 2
181.     DATA "partir¢","canter…","rivel¢","prover…","ripart","perchŠ","battŠ"
182.     DATA "hangman","gallows","reveal","keypress","report","letters","basic"
183. END SUB
184.  
185.  

It is fine how I have no tested the ripetition of the same box also after it is vanished!  LOL
First rule of debug: do anything illogical with application interface and functions :-)

LOL for my massive EXIT FUNCTION where I miss to see that I am at the end of the function! :-)))

Here a way quicker to evaluate and assign the correlate value of keyboard for accent

Code: QB64: [Select]

1.         ELSEIF INSTR("àèìòù", K$) THEN
2.             getBoxLetter$ = MID$("…Š¢£", INSTR("àèìòù", K$), 1)
3.         END IF

so the code become this following

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Hangman with Mouse and File Load" ' B+  2019-06-16 mouse only update with load from file
3. DEFINT A-Z
4. TYPE XYtype
5.     X AS INTEGER
6.     Y AS INTEGER
7. END TYPE
8. TYPE LetterBox
9.     XY AS XYtype
10.     Show AS INTEGER ' 0, -1 revealed when matched, stay revealed
11.     Letter AS STRING '  letter to match
12. END TYPE
13. CONST xmax = 800, ymax = 400, boxSize = 50
14. CONST hung = "Hanged!", Accenti = "…Š¢£" ' allows 7 misses
15. DIM SHARED LB(1 TO 31) AS LetterBox, round, Letters$, nHung, done
16. REDIM SHARED w$(1 TO 1) 'for redim to number of words in setUpGame
17. DIM place, k$
18.  
19.  
20. SCREEN _NEWIMAGE(xmax, ymax, 32)
21. _SCREENMOVE 360, 60
22. SetUpGame
23. DO ' main loop manages the letters to select from and removes letter when selected
24.     Letters$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + Accenti
25.     FOR place = 1 TO 31: LB(place).Show = -1: NEXT
26.     nHung = 0: done = 0: IF round = 0 THEN round = 1
27.     CLS: Update
28.     WHILE done = 0
29.         Update 'this handles the rest or the game
30.         k$ = getBoxLetter$
31.         IF LEN(k$) THEN
32.             IF ASC(k$) = 27 THEN SYSTEM 'escape the game
33.             place = INSTR(Letters$, k$)
34.             IF place AND k$ <> " " THEN
35.                 LB(place).Show = 0
36.                 Letters$ = MID$(Letters$, 1, place - 1) + "-" + MID$(Letters$, place + 1)
37.                 IF INSTR(w$(round), k$) = 0 THEN nHung = nHung + 1
38.             END IF
39.             IF done THEN Sleep2
40.             _LIMIT 60
41.         END IF
42.     WEND
43. LOOP
44.  
45. FUNCTION getBoxLetter$
46.     DIM m, mx, my, mb, i, K$
47.     DO
48.         K$ = UCASE$(INKEY$)
49.         WHILE _MOUSEINPUT: WEND
50.     LOOP UNTIL LEN(K$) <> 0 OR _MOUSEBUTTON(1)
51.     mb = _MOUSEBUTTON(1) '            left button down
52.     IF mb THEN '                      get last place mouse button was down
53.         WHILE mb '                    wait for mouse button release as a "click"
54.             m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
55.         WEND
56.         FOR i = 1 TO 31 '             now find which box was clicked
57.             IF mx > LB(i).XY.X AND mx < LB(i).XY.X + boxSize THEN
58.                 IF my > LB(i).XY.Y AND my < LB(i).XY.Y + boxSize THEN
59.                     IF LB(i).Show THEN
60.                         IF i < 27 THEN
61.                             getBoxLetter$ = CHR$(i + 64)
62.                         ELSEIF i > 26 THEN
63.                             getBoxLetter$ = MID$(Accenti, i - 26, 1)
64.                         END IF
65.                         EXIT FUNCTION
66.                     END IF
67.                 END IF
68.             END IF
69.         NEXT
70.     END IF
71.     'àèìòù  =     …Š¢£
72.     IF NOT K$ = "" THEN
73.         IF (ASC(K$) > 64 AND ASC(K$) < 91) THEN
74.             getBoxLetter$ = K$
75.         ELSEIF INSTR("àèìòù", K$) THEN
76.             getBoxLetter$ = MID$("…Š¢£", INSTR("àèìòù", K$), 1)
77.         END IF
78.     END IF
79. END FUNCTION
80.  
81. FUNCTION Reveal$ ' from remaining selected letters a * will cover unchosen letters in w$(round)
82.     DIM i, b$
83.     FOR i = 1 TO LEN(w$(round))
84.         IF INSTR(Letters$, MID$(w$(round), i, 1)) > 0 THEN
85.             b$ = b$ + "*"
86.         ELSE
87.             b$ = b$ + MID$(w$(round), i, 1)
88.         END IF
89.     NEXT
90.     Reveal$ = b$
91. END FUNCTION
92.  
93. SUB Update 'draw everything for screen 0 and while we're at it decide if word round is done
94.     DIM i, xoff, yoff
95.     xoff = (boxSize - 8) / 2: yoff = (boxSize - 16) / 2 ' for letters in box
96.     FOR i = 1 TO 31
97.         LINE (LB(i).XY.X, LB(i).XY.Y)-STEP(boxSize, boxSize), &HFF000000, BF
98.         IF LB(i).Show <> 0 THEN
99.             LINE (LB(i).XY.X + 5, LB(i).XY.Y + 5)-STEP(boxSize - 10, boxSize - 10), &HFF0000BB, BF
100.             COLOR &HFFBBBBBB, &HFF0000BB
101.             _PRINTSTRING (LB(i).XY.X + xoff, LB(i).XY.Y + yoff), LB(i).Letter
102.         END IF
103.     NEXT
104.     COLOR &HFFBBBBBB, &HFF000000
105.     CP 2, "Hangman: " + Reveal$
106.     CP 4, "Press a letter from: " + Letters$
107.     CP 6, "Gallows Report: " + MID$(hung, 1, nHung)
108.     IF Reveal$ = w$(round) THEN CP 8, "Congratulations! you got it.": done = -1
109.     IF LEN(hung) = nHung THEN CP 10, "Yikes! You were hung by: " + w$(round): done = -1
110.     IF done AND round + 1 > UBOUND(w$) THEN
111.         CP 12, "Hangman is out of words to play.": _DISPLAY: _DELAY 3: END
112.     END IF
113.     IF done AND round + 1 <= UBOUND(w$) THEN round = round + 1: CP 12, "Click me or press any to continue..."
114.     _DISPLAY
115. END SUB
116.  
117. SUB CP (row, s$)
118.     LOCATE row, (100 - LEN(s$)) / 2: PRINT s$
119. END SUB
120.  
121. SUB Sleep2 'pause until keypress or mouseclick
122.     DIM k$
123.     DO
124.         k$ = INKEY$
125.         WHILE _MOUSEINPUT: WEND
126.         _LIMIT 30
127.     LOOP UNTIL LEN(k$) <> 0 OR _MOUSEBUTTON(1)
128.     _KEYCLEAR
129. END SUB
130.  
131. SUB SetUpGame
132.     DIM i, x, y 'for letter boxes there are 13 x 2 board and it is past 11 lines down screen
133.     REDIM w$(1 TO 7)
134.     CONST xoffset = INT((xmax - boxSize * 13) / 2)
135.     CONST yoffset = 11 * 16 + INT((ymax - boxSize * 2 - 11 * 16) / 2)
136.     FOR y = 1 TO 3 '                    set screen XY locations for Letter Boxes
137.         FOR x = 1 TO 13
138.             i = i + 1
139.             IF i = 32 THEN EXIT FOR
140.             LB(i).XY.X = xoffset + (x - 1) * boxSize: LB(i).XY.Y = yoffset + (y - 1) * boxSize
141.             IF i < 27 THEN
142.                 LB(i).Letter = CHR$(i + 64)
143.             ELSEIF i > 26 THEN
144.                 LB(i).Letter = MID$(Accenti, i - 26, 1)
145.             END IF
146.             LB(i).Show = -1
147.         NEXT
148.     NEXT
149.     LoadWords
150. END SUB
151.  
152. SUB LoadWords
153.     DIM i, s$, fileName$
154.     INPUT "If you would like to load words from a file, enter that name now > ", fileName$
155.     IF _FILEEXISTS(fileName$) THEN
156.         OPEN fileName$ FOR INPUT AS #1
157.         WHILE EOF(1) = 0
158.             INPUT #1, s$
159.             i = i + 1
160.             REDIM _PRESERVE w$(1 TO i)
161.             w$(i) = _TRIM$(UCASE$(s$))
162.         WEND
163.         CLOSE #1
164.         PRINT "Loaded"; i; "items from "; fileName$
165.         _TITLE "Hangman with Mouse, Word Source: " + fileName$
166.     ELSE
167.         PRINT "Loading default set of words..."
168.         REDIM w$(1 TO 7)
169.         FOR i = 1 TO 7: READ s$: w$(i) = UCASE$(s$): NEXT
170.         _TITLE "Hangman with Mouse, Word Source: default word list"
171.     END IF
172.     _DELAY 2
173.     DATA "partir¢","canter…","rivel¢","prover…","ripart","perchŠ","battŠ"
174.     DATA "hangman","gallows","reveal","keypress","report","letters","basic"
175. END SUB
176.  
177.  

Title: Re: Hangman
Post by: SMcNeill on June 18, 2019, 06:45:19 pm

A quick suggestion from me:

Code: [Select]

FUNCTION getBoxLetter$
    DIM m, mx, my, mb, i, K$
    DO
        K$ = UCASE$(INKEY$)
        WHILE _MOUSEINPUT: WEND
        _LIMIT 30 'Add this line into the program to reduce CPU usage as you have an endless loop here which doesn't play nice with other programs.
    LOOP UNTIL LEN(K$) <> 0 OR _MOUSEBUTTON(1)

Title: Re: Hangman
Post by: SMcNeill on June 18, 2019, 08:20:53 pm

I don't want to reinvent a whole hangman program, but here's a little idea which you guys might want to incorporate into the games you're creating -- a means to rate difficulty settings.

Take this little program as a quick demo:

Code: QB64: [Select]

1. DIM SHARED Words(100000) AS STRING
2. DIM SHARED WordCount(100000) AS LONG
3. DIM SHARED Difficulty(100000) AS LONG
4. CONST MinLength = 4, MaxLength = 10
5.  
6. SCREEN _NEWIMAGE(800, 600, 32)
7.  
8. File$ = "kjv10.txt" 'the King James Version 10 of the bible, from Project Gutenberg
9.  
10. PRINT "Processing book..."
11.  
12. LoadLists File$
13. PRINT "There are a total of"; WordCount(0); " words in our book."
14.  
15. FilterLists
16. PRINT "After we filter to exclude words too short, or too long, we have"; WordCount(0); " words left."
17. SLEEP
18.  
19. SortByWord
20. SortByFrequency
21.  
22. FOR i = 1 TO WordCount(0)
23.     PRINT Words(i); WordCount(i),
24. NEXT
25.  
26.  
27.  
28.  
29.  
30.  
31.  
32. SUB LoadLists (File$)
33.     DIM i AS LONG, u AS LONG
34.     IF _FILEEXISTS(File$) THEN
35.         OPEN File$ FOR BINARY AS #1
36.         FileLength = LOF(1)
37.         temp$ = SPACE$(FileLength)
38.         GET #1, 1, temp$
39.         CLOSE
40.     ELSE
41.         temp$ = "The user was too lazy to provide us any word lists to choose from, so this is the default choices which were insterted into the program by Steve, just because he wanted something to work with, even if the end user might be a smart ass like Pete pretends to be sometimes."
42.     END IF
43.     book$ = _TRIM$(UCASE$(temp$))
44.     l = 0
45.     DO
46.         l = 0
47.         l1 = INSTR(oldl, book$, CHR$(32))
48.         l2 = INSTR(oldl, book$, CHR$(13)) 'CR
49.         l3 = INSTR(oldl, book$, CHR$(10)) 'LF
50.         IF l1 > 0 AND l1 < l2 AND l1 < l3 THEN l = l1: GOTO skipcheck
51.         IF l2 > 0 AND l2 < l3 THEN l = l2: GOTO skipcheck
52.         IF l3 > 0 THEN l = l3
53.         skipcheck:
54.         IF l = 0 THEN EXIT DO
55.         word$ = UCASE$(MID$(book$, oldl, l - oldl))
56.         i = 1
57.         DO UNTIL i > LEN(word$)
58.             IF ASC(word$, i) < 65 OR ASC(word$, i) > 90 THEN
59.                 word$ = LEFT$(word$, i - 1) + MID$(word$, i + 1)
60.             ELSE
61.                 i = i + 1
62.             END IF
63.         LOOP
64.         newword = -1
65.         FOR i = 1 TO u
66.             IF word$ = Words(i) THEN
67.                 newword = 0: EXIT FOR
68.             END IF
69.         NEXT
70.         IF newword THEN
71.             u = u + 1
72.             Words(u) = word$: WordCount(u) = 1
73.         ELSE
74.             WordCount(i) = WordCount(i) + 1
75.         END IF
76.         oldl = l + 1
77.         DO UNTIL MID$(word$, oldl) <> CHR$(32) AND MID$(word$, oldl) <> CHR$(13) AND MID$(word$, oldl) <> CHR$(10)
78.             oldl = oldl + 1
79.         LOOP
80.     LOOP
81.     WordCount(0) = u
82. END SUB
83.  
84. SUB FilterLists
85.     FOR i = 1 TO WordCount(0)
86.         l = LEN(Words(i))
87.         IF l < MinLength OR l > MaxLength THEN
88.             'it doesn't fit our length criteria to be a "good word"
89.         ELSE
90.             goodword = goodword + 1
91.             Words(goodword) = Words(i)
92.             WordCount(goodword) = WordCount(i)
93.         END IF
94.     NEXT
95.     WordCount(0) = goodword
96. END SUB
97.  
98.  
99. SUB SortByWord
100.     DIM gap AS LONG
101.     'This is the routine I tend to use personally and promote.
102.     'It's short, simple, and easy to implement into code.
103.  
104.     gap = WordCount(0)
105.     index = WordCount(0)
106.     DO
107.         gap = INT(gap / 1.247330925103979)
108.         IF gap < 1 THEN gap = 1
109.         i = 1
110.         swapped = 0
111.         DO
112.             IF Words(i) > Words(i + gap) THEN
113.                 SWAP Words(i), Words(i + gap)
114.                 SWAP WordCount(i), WordCount(i + gap)
115.                 swapped = -1
116.             END IF
117.             i = i + 1
118.         LOOP UNTIL i + gap > index
119.     LOOP UNTIL gap = 1 AND swapped = 0
120. END SUB
121.  
122. SUB SortByFrequency
123.     DIM gap AS LONG
124.     'This is the routine I tend to use personally and promote.
125.     'It's short, simple, and easy to implement into code.
126.  
127.     gap = WordCount(0)
128.     index = WordCount(0)
129.     DO
130.         gap = INT(gap / 1.247330925103979)
131.         IF gap < 1 THEN gap = 1
132.         i = 1
133.         swapped = 0
134.         DO
135.             IF WordCount(i) > WordCount(i + gap) THEN
136.                 SWAP Words(i), Words(i + gap)
137.                 SWAP WordCount(i), WordCount(i + gap)
138.                 swapped = -1
139.             END IF
140.             i = i + 1
141.         LOOP UNTIL i + gap > index
142.     LOOP UNTIL gap = 1 AND swapped = 0
143. END SUB
144.  

So this loads a whole book for us, and then uses it to create a word list from all the words in the book, while also counting the word frequency.  It then sorts our words by alphabetical order and frequency for us.

At this point, all one would need is to come up with a formula they like to generate various difficulty settings.

Personally, I'd go for something like:  Frequency (guessing a word that appears once in a book is going to be a lot harder than guessing a word which appears thousands of times), modified by length of the word (very short words are hard to guess just because there's so many of them to choose from, and very long words are hard to guess just from lack of general familiarity with them), with a modifier for the number of letters used in the word.  (Subdermatoglyphic is a rare word, with a ton of letters, but it has 17 unique letters!  There's not a lot of letters which you can actually guess and not have appear in it, in a game of hangman.)

So just choose a formula you like for a range of difficulty, and then you can make your game customizable so the user can play a Trivial, Easy, Average, Hard, or Impossible game...   ;)

Title: Re: Hangman
Post by: bplus on June 18, 2019, 09:32:55 pm

Hi TempodiBasic,

This is brilliant!

Code: QB64: [Select]

1.         ELSEIF INSTR("àèìòù", K$) THEN
2.             getBoxLetter$ = MID$("…Š¢£", INSTR("àèìòù", K$), 1)
3.         END IF
4.  

I was suspecting there was such a shortening of code.


Hi Steve,

You may be onto something with your word value analysis. It could be more motivating to challenge someone to go for higher levels of play and more word practice. One trick is to get a good formula that does motivate and another is to not make using it so complicated it takes away from playing the game, probably that is the coder's job.

Title: Re: Hangman
Post by: bplus on June 18, 2019, 10:31:56 pm

OK Steve, you have me thinking.

I wouldn't mind reinventing hangman in the least.

I am wondering how common some of the words are in the King James Version of the Bible to whoever the audience is who would be playing the game, or what ever source you get the word list. There is something to add to formula, how common are the words?

Then there is letter frequencies as you mentioned, along with letter amounts and repetitions there are letter frequencies ie e is my number one vowel, s constanent non vowel... which gets me wondering how an AI would play the game? It would start making a list of words that have e in 2nd position and s in 5th...
How popular letters are is very important for the guessing strategy.

Kind of difficult to narrow all this down to a formula but I guess the AI player is a digression if not distraction.

Maybe look at it a different way, how many guesses should some particular word take? and score it like golf that word is a par 6, oh and that word is a par 9! So collect a set of words that is a par 80 or 100 and the game is on!

Title: Re: Hangman
Post by: SMcNeill on June 18, 2019, 11:11:41 pm

I was thinking more of a simple 5-star type system...

Word Length — Base Difficulty
4-6 letters — 10 points
7-10 letters — 15 points
11+ letters — 20 points

Frequency — Point Modifier
1 time — 2.5
2-5 times — 2
5-10 times — 1.5
11 - 25 times — 1
25 - 100 times — 0.9
101 - 500 times — 0.75
501+ times — 0.5

Difficulty Formula would be:  Base Difficulty * Point Modifier * 26 / Unique Letter Count

So JESUS would be: 10 * 0.5 * 26 / 4 = 32.5

I’d want to run all the words through the formula to see the min/max range, but a simple percentage distribution should give you a nice set of difficulty levels. 

Bottom 20% are Trivial (1 star words)
21-40% are Easy (2 star words)
41 - 60% are Average
61 - 80% are Hard
81%+ are Impossible (5 star words)

Instead of a par system where you try and predict how many guesses a person will need, instead it’s just a simple formula to divide the words into multiple difficult lists.

Title: Re: Hangman
Post by: bplus on June 19, 2019, 10:13:14 am

Quote

I’d want to run all the words through the formula to see the min/max range, but a simple percentage distribution should give you a nice set of difficulty levels.

Hi Steve,

Yes I am very interested in seeing / playing the lists this idea might generate.

I don't see accounting for letter frequency stats which is what people usually base their Hangman strategy on, at least until they have a few letters showing. If the word is made up rare letters like z's and q's it is going to be hard to get them guessed.
 

Title: Re: Hangman
Post by: bplus on June 19, 2019, 11:45:01 am

Letter frequencies from Internet lookup:

Quote

E   11.1607%   56.88   M   3.0129%   15.36
A   8.4966%   43.31   H   3.0034%   15.31
R   7.5809%   38.64   G   2.4705%   12.59
I   7.5448%   38.45   B   2.0720%   10.56
O   7.1635%   36.51   F   1.8121%   9.24
T   6.9509%   35.43   Y   1.7779%   9.06
N   6.6544%   33.92   W   1.2899%   6.57
S   5.7351%   29.23   K   1.1016%   5.61
L   5.4893%   27.98   V   1.0074%   5.13
C   4.5388%   23.13   X   0.2902%   1.48
U   3.6308%   18.51   Z   0.2722%   1.39
D   3.3844%   17.25   J   0.1965%   1.00
P   3.1671%   16.14   Q   0.1962%   (1)


ref https://www3.nd.edu/~busiforc/handouts/cryptography/letterfrequencies.html

"EARIOTNSLCUDPMHGBFYWKVXZJQ"  try this string of letters in a Hangman with File Loader

Just go down the string of letters until about S (if not hanged before that).

Title: Re: Hangman
Post by: SMcNeill on June 19, 2019, 02:21:14 pm

For letter frequency, if you’re interested, just use the value of scrabble tiles.  ;)

Title: Re: Hangman
Post by: bplus on June 19, 2019, 03:34:16 pm

Hi TempodiBasic,

One tiny, tiny little detail in your last code:

Code: QB64: [Select]

1.             IF place AND k$ <> " " THEN       'notice and k$ <> " "  a space!
2.                 LB(place).Show = 0
3.                 Letters$ = MID$(Letters$, 1, place - 1) + " " + MID$(Letters$, place + 1)
4.                 '                                        not "-" should be space " "
5.                 ' so to blank out letters that are selected, I change from"-" to a space " "
6.  

Title: Re: Hangman
Post by: TempodiBasic on June 19, 2019, 05:48:40 pm

Yep
you're right but I haven't notice that because I see well "-", but the final choice is to cancel and not to mask the choisen letters, so " "!

Text Only | Text with Attachments