|
Post by B+ on Jun 15, 2019 4:09:25 GMT
'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
|
|
|
Post by B+ on Jun 15, 2019 12:15:23 GMT
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)?
|
|
|
Post by tsh73 on Jun 15, 2019 21:37:24 GMT
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.
|
|
|
Post by B+ on Jun 15, 2019 23:37:45 GMT
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. ;-)) But maybe I can make it easier to see the letters available, stay tuned...
|
|
|
Post by B+ on Jun 16, 2019 0:09:02 GMT
'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
|
|
|
Post by B+ on Jun 16, 2019 12:45:09 GMT
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
|
|
|
Post by plus on Oct 8, 2022 17:25:06 GMT
Oh I did post this already! I ran into it recently and love the little game with no special window needed to play :-))
|
|