A Little Game of Hangman Anyone?

[B+]

'Hangman for JB v2.0 by B+ from Hangman 1.bas for QB64, 2019-06-14
global HUNG$, LETTERS$, ROUND, NHUNG, DONE, NWORDS
HUNG$ = "Hanged!" ' allows 7 misses
CALL LoadWords
WHILE 1 ' main loop manages the letters to select from and removes letter when selected
   LETTERS$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   NHUNG = 0: DONE = 0: IF ROUND = 0 THEN ROUND = 1
   CLS : CALL Update
   WHILE DONE = 0
       k$ = UPPER$(INPUT$(1))
       place = INSTR(LETTERS$, k$)
       IF place THEN LETTERS$ = MID$(LETTERS$, 1, place - 1) + "-" + MID$(LETTERS$, place + 1)
       IF INSTR(w$(ROUND), k$) = 0 THEN NHUNG = NHUNG + 1
       CALL Update
   WEND
WEND

FUNCTION Reveal$() ' from remaining selected letters a * will cover unchosen letters in w$(ROUND)
   FOR i = 1 TO LEN(w$(ROUND))
       IF INSTR(LETTERS$, MID$(w$(ROUND), i, 1)) > 0 THEN b$ = b$ + "*" ELSE b$ = b$ + MID$(w$(ROUND), i, 1)
   NEXT
   Reveal$ = b$
END FUNCTION

SUB Update ' everything for screen
   CALL CP 8, "Hangman: " + Reveal$()
   CALL CP 10, "Press a letter from: " + LETTERS$
   CALL CP 12, "Gallows Report: " + MID$(HUNG$, 1, NHUNG)
   IF Reveal$() = w$(ROUND) THEN CALL CP 14, "Congratulations! you got it.": DONE = -1
   IF LEN(HUNG$) = NHUNG THEN CALL CP 14, "Yikes! You were hung by: " + w$(ROUND): DONE = -1
   IF DONE AND ROUND + 1 > NWORDS THEN CALL CP 16, "Hangman is out of words to play.": t$ = INPUT$(1) : END
   IF DONE AND ROUND + 1 <= NWORDS THEN ROUND = ROUND + 1: CALL CP 16, "Press any to continue...": t$ = INPUT$(1)
END SUB

SUB CP row, s$  ' Center Print on row, string s$
   LOCATE (80 - LEN(s$)) / 2, row : PRINT s$
END SUB

SUB LoadWords  ' load w$() with game words
   NWORDS = 11
   DIM w$(NWORDS)
   FOR i = 1 TO NWORDS : READ s$: w$(i) = UPPER$(s$): NEXT
   DATA "hangman","gallows","letters","edit","hanged","report","reveal","round","update","file","just basic"
END SUB


[B+]

Oh I forgot WORD$! So an even smaller version of Hangman:
'Hangman for JB v2.0 by B+ from Hangman 1.bas for QB64, 2019-06-14
global W$, HUNG$, LETTERS$, ROUND, NHUNG, DONE, NWORDS
NWORDS = 11
HUNG$ = "Hanged!" ' allows 7 misses
hws$ = "hangman,gallows,letters,edit,hanged,report,reveal,round,update,file,just basic"
WHILE 1 ' main loop manages the letters to select from and removes letter when selected
   LETTERS$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   NHUNG = 0: DONE = 0: IF ROUND = 0 THEN ROUND = 1
   W$ = UPPER$(WORD$(hws$, ROUND, ","))
   CLS : CALL Update
   WHILE DONE = 0
       k$ = UPPER$(INPUT$(1))
       place = INSTR(LETTERS$, k$)
       IF place THEN LETTERS$ = MID$(LETTERS$, 1, place - 1) + "-" + MID$(LETTERS$, place + 1)
       IF INSTR(W$, k$) = 0 THEN NHUNG = NHUNG + 1
       CALL Update
   WEND
WEND

FUNCTION Reveal$() ' from remaining selected letters a * will cover unchosen letters in w$(ROUND)
   FOR i = 1 TO LEN(W$)
       IF INSTR(LETTERS$, MID$(W$, i, 1)) > 0 THEN b$ = b$ + "*" ELSE b$ = b$ + MID$(W$, i, 1)
   NEXT
   Reveal$ = b$
END FUNCTION

SUB Update ' everything for screen
   CALL CP 8, "Hangman: " + Reveal$()
   CALL CP 10, "Press a letter from: " + LETTERS$
   CALL CP 12, "Gallows Report: " + MID$(HUNG$, 1, NHUNG)
   IF Reveal$() = W$ THEN CALL CP 14, "Congratulations! you got it." : DONE = -1
   IF LEN(HUNG$) = NHUNG THEN CALL CP 14, "Yikes! You were hung by: " + W$ : DONE = -1
   IF DONE AND ROUND + 1 > NWORDS THEN CALL CP 16, "Hangman is out of words to play.": t$ = INPUT$(1) : END
   IF DONE AND ROUND + 1 <= NWORDS THEN ROUND = ROUND + 1: CALL CP 16, "Press any to continue...": t$ = INPUT$(1)
END SUB

SUB CP row, s$  ' Center Print on row, string s$
   LOCATE (80 - LEN(s$)) / 2, row : PRINT s$
END SUB


BTW, why is the fan running so hard? Is it INPUT$(1)?

[tsh73]

BTW, why is the fan running so hard? Is it INPUT$(1)?

Yes, it is.
Really this is question for Carl.

BTW, game counts as "misses" pressing of non-leters (digits, spaces)
Also it counts if used letter was selected second time.
Probably that shouldn't be counted as guesses.

[B+]

Jun 15, 2019 21:37:24 GMT tsh73 said:

BTW, why is the fan running so hard? Is it INPUT$(1)?

Yes, it is.
Really this is question for Carl.

BTW, game counts as "misses" pressing of non-leters (digits, spaces)
Also it counts if used letter was selected second time.
Probably that shouldn't be counted as guesses.

If the letter was part of the word, it doesn't count against you if you press it again.
But yes, if you think the letter "c" that didn't work the first time will work if you try it again... even when it is crossed of the list of letters to select from... well I think maybe you should be rewarded for your actions. ;-)) 

CALL CP 10, "Press a letter from: " + LETTERS$

But maybe I can make it easier to see the letters available, stay tuned...

[B+]

'Hangman for JB v2.0 by B+ from Hangman 1.bas for QB64, 2019-06-14 rev 6-15
global W$, HUNG$, LETTERS$, ROUND, NHUNG, DONE, NWORDS
NWORDS = 11 : HUNG$ = "Hanged!" ' allows 7 misses
hws$ = "hangman,gallows,letters,edit,hanged,report,reveal,round,update,file,just basic"
WHILE 1 ' main loop manages the letters to select from and removes letter when selected
   LETTERS$ = "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z"
   NHUNG = 0: DONE = 0: IF ROUND = 0 THEN ROUND = 1
   W$ = UPPER$(WORD$(hws$, ROUND, ","))
   CLS : CALL Update
   WHILE DONE = 0
       k$ = UPPER$(INPUT$(1))
       place = INSTR(LETTERS$, k$)
       IF place THEN LETTERS$ = MID$(LETTERS$, 1, place - 1) + " " + MID$(LETTERS$, place + 1) ELSE PLAYWAVE "pleaseSeeDirections"
       IF INSTR(W$, k$) = 0 THEN NHUNG = NHUNG + 1
       CALL Update
   WEND
WEND

FUNCTION Reveal$() ' from remaining selected letters a * will cover unchosen letters in w$(ROUND)
   FOR i = 1 TO LEN(W$)
       IF INSTR(LETTERS$, MID$(W$, i, 1)) > 0 THEN b$ = b$ + "*" ELSE b$ = b$ + MID$(W$, i, 1)
   NEXT
   Reveal$ = b$
END FUNCTION

SUB Update ' everything for screen
   CALL CP 8, "Hangman: " + Reveal$()
   CALL CP 10, "Press letter only >>> " + LETTERS$
   CALL CP 12, "Gallows Report: " + MID$(HUNG$, 1, NHUNG)
   IF Reveal$() = W$ THEN CALL CP 14, "Congratulations! you got it." : DONE = -1
   IF LEN(HUNG$) = NHUNG THEN CALL CP 14, "Yikes! You were hung by: " + W$ : DONE = -1
   IF DONE AND ROUND + 1 > NWORDS THEN CALL CP 16, "Hangman is out of words to play.": t$ = INPUT$(1) : END
   IF DONE AND ROUND + 1 <= NWORDS THEN ROUND = ROUND + 1: CALL CP 16, "Press any to continue...": t$ = INPUT$(1)
END SUB

SUB CP row, s$  ' Center Print on row, string s$
   LOCATE (80 - LEN(s$)) / 2, row : PRINT s$
END SUB


So BEEP doesn't work?  And apparently it doesn't matter what you put in quotes after PLAYWAVE

[B+]

Jun 15, 2019 21:37:24 GMT tsh73 said:

BTW, why is the fan running so hard? Is it INPUT$(1)?

Yes, it is.
Really this is question for Carl.

BTW, game counts as "misses" pressing of non-leters (digits, spaces)
Also it counts if used letter was selected second time.
Probably that shouldn't be counted as guesses.

OK, OK another person for whom English is their 2nd language also said same so here is fix:

'Hangman for JB v2.0 by B+ from Hangman 1.bas for QB64, 2019-06-14 rev 6-15 rev 6-16
global W$, HUNG$, LETTERS$, ROUND, NHUNG, DONE, NWORDS
NWORDS = 11 : HUNG$ = "HANGED!" ' allows 7 misses
hws$ = "hangman,gallows,letters,edit,hanged,report,reveal,round,update,file,just basic"
WHILE 1 ' main loop manages the letters to select from and removes letter when selected
   LETTERS$ = "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z"
   NHUNG = 0: DONE = 0: IF ROUND = 0 THEN ROUND = 1
   W$ = UPPER$(WORD$(hws$, ROUND, ","))
   CALL Update
   WHILE DONE = 0
       k$ = UPPER$(INPUT$(1))
       place = INSTR(LETTERS$, k$)
       IF place AND MID$(LETTERS$, place, 1) <> " " THEN
           LETTERS$ = MID$(LETTERS$, 1, place - 1) + " " + MID$(LETTERS$, place + 1)
           IF INSTR(W$, k$) = 0 THEN NHUNG = NHUNG + 1
           CALL Update
       END IF
   WEND
WEND

FUNCTION Reveal$() ' from remaining selected letters a * will cover unchosen letters in w$(ROUND)
   FOR i = 1 TO LEN(W$)
       IF INSTR(LETTERS$, MID$(W$, i, 1)) > 0 THEN b$ = b$ + "*" ELSE b$ = b$ + MID$(W$, i, 1)
   NEXT
   Reveal$ = b$
END FUNCTION

SUB Update ' everything for screen
   CLS
   CALL CP 8, "Hangman: " + Reveal$()
   CALL CP 10, "Press letter only >>> " + LETTERS$
   CALL CP 12, "Gallows Report: " + MID$(HUNG$, 1, NHUNG)
   IF Reveal$() = W$ THEN CALL CP 14, "Congratulations! you got it." : DONE = -1
   IF LEN(HUNG$) = NHUNG THEN CALL CP 14, "Yikes! You were hung by: " + W$ : DONE = -1
   IF DONE AND ROUND + 1 > NWORDS THEN CALL CP 16, "Hangman is out of words to play.": t$ = INPUT$(1) : END
   IF DONE AND ROUND + 1 <= NWORDS THEN ROUND = ROUND + 1: CALL CP 16, "Press any to continue...": t$ = INPUT$(1)
END SUB

SUB CP row, s$  ' Center Print on row, string s$
   LOCATE (80 - LEN(s$)) / 2, row : PRINT s$
END SUB


[plus]

Oh I did post this already! I ran into it recently and love the little game with no special window needed to play :-))