Author Topic: Hangman  (Read 6316 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

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

Offline bplus

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

Offline bplus

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

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

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Hangman
« Reply #3 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.
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Hangman
« Reply #4 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.
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline TempodiBasic

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

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Hangman
« Reply #6 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!


Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Hangman
« Reply #7 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. _TITLE "Hangman: keypress only with file loader" ' B+  2019-06-16 mod
  2. DEFINT A-Z
  3. CONST hung = "Hanged!" ' allows 7 misses
  4. REDIM SHARED w$(1 TO 1), round, selectLetters$, nHung, done
  5. DIM place, k$
  6. LoadWords
  7. DO ' main loop manages the letters to select from and removes letter when selected
  8.     selectLetters$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  9.     nHung = 0: done = 0: IF round = 0 THEN round = 1
  10.     CLS: Update
  11.     WHILE done = 0
  12.         DO
  13.             k$ = "": WHILE LEN(k$) = 0: k$ = INKEY$: _LIMIT 60: WEND
  14.             k$ = UCASE$(k$)
  15.         LOOP UNTIL INSTR(selectLetters$ + CHR$(27), k$) AND k$ <> " "
  16.         IF ASC(k$) = 27 THEN SYSTEM 'escape the game
  17.         place = INSTR(selectLetters$, k$)
  18.         IF place THEN selectLetters$ = MID$(selectLetters$, 1, place - 1) + " " + MID$(selectLetters$, place + 1)
  19.         IF INSTR(w$(round), k$) = 0 THEN nHung = nHung + 1
  20.         Update
  21.     WEND
  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.  
  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.  
  39. SUB cp (row, s$)
  40.     LOCATE row, (80 - LEN(s$)) / 2: PRINT s$
  41.  
  42. SUB LoadWords
  43.     DIM i, s$, fileName$
  44.     INPUT "If you would like to load words from a file, enter that name now > ", fileName$
  45.     IF _FILEEXISTS(fileName$) THEN
  46.         OPEN fileName$ FOR INPUT AS #1
  47.         WHILE EOF(1) = 0
  48.             INPUT #1, s$
  49.             i = i + 1
  50.             REDIM _PRESERVE w$(1 TO i)
  51.             w$(i) = _TRIM$(UCASE$(s$))
  52.         WEND
  53.         CLOSE #1
  54.         PRINT "Loaded"; i; "items from "; fileName$
  55.         _TITLE "Hangman with Mouse, Word Source: " + fileName$
  56.     ELSE
  57.         PRINT "Loading default set of words..."
  58.         REDIM w$(1 TO 7)
  59.         FOR i = 1 TO 7: READ s$: w$(i) = UCASE$(s$): NEXT
  60.         _TITLE "Hangman: Keypress Only   Word Source: Default Word List"
  61.     END IF
  62.     _DELAY 2
  63.     DATA "hangman","gallows","reveal","keypress","report","letters","basic"
  64.  


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

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
« Last Edit: June 16, 2019, 01:32:14 pm by bplus »

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: Hangman
« Reply #8 on: June 16, 2019, 12:09:48 pm »
Hi Bplus

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

 
Hangman Bplus for IT.jpg

Thanks to share
Programming isn't difficult, only it's  consuming time and coffee

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Hangman
« Reply #9 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)

Offline TempodiBasic

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

and screenshot
 
HangMan IT Mod.jpg


Thanks Bplus
Programming isn't difficult, only it's  consuming time and coffee

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Hangman
« Reply #11 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 :)
« Last Edit: June 16, 2019, 08:54:44 pm by bplus »

Offline TempodiBasic

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

Thanks to sharing and trill my imagination!
Programming isn't difficult, only it's  consuming time and coffee

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Hangman
« Reply #13 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.
« Last Edit: June 18, 2019, 10:39:18 am by bplus »

Offline TempodiBasic

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

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