' |\

' |  \      /|

' |    \  /..|

' |      \...|      This program is by KeiProductions Inc.

' |        \.|      Visit us at http://fn2.freenet.edmonton.ab.ca/~djke/

' |          \

' |____________\

'

'            K e i P r o d u c t i o n s   p r e s e n t s . . .

'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

'

'                     G U E S S   T H A T   P H R A S E

'

'                          (c) 1998 KeiProductions

'                

'                                   * * *

'

'This game is a twist of the classic game of Hangman.  In this game, you still

'  guess a phrase, but your goal is to stop a car from crashing into a wall.

'

'                REQUIRES: QBasic 1.1, a computer, a keyboard.

'

'    Feel free to distribute this as you wish, just don't copy the code!

'

'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

'

'               P R E S S   S H I F T - F 5   T O   S T A R T !

'

'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ



DEFINT A-Z  'Speed up the game. Who needs decimal places???



DECLARE SUB mainmenu ()

DECLARE SUB oneplayer ()

DECLARE SUB twoplayer ()

DECLARE SUB mainloop ()

DECLARE SUB options ()

DECLARE SUB story ()

DECLARE SUB quitit ()

DECLARE SUB getgraphics ()

DECLARE SUB gameover ()

DECLARE SUB youwin ()

DECLARE SUB center (text$, row)

DECLARE SUB wipe ()

DECLARE SUB border ()

DECLARE SUB colorandom ()

DECLARE SUB changecolor (pal, r, g, b)

DECLARE SUB getcolor (pal, r, g, b)



DIM SHARED car(424)    'The array that holds the picture of the car

DIM SHARED brwall(540) 'The array that holds the picture of the brick wall

DIM SHARED c(5)     'Array that holds the color attrubutes

DIM SHARED choice   'Choice is what the mainmenu sub returns: 1, 2, 3, 4 or 5

DIM SHARED phrase$  'The phrase you have to guess

DIM SHARED isitnew  'Used by the BORDER sub, to see if you're starting it over

DIM SHARED snd      'Is the sound on? 1 if yes, 2 if no



snd = 1



SCREEN 13

CLS



ON ERROR GOTO errorh



getgraphics   'Get the graphics needed to run the game



start! = TIMER                       'Pause

DO: LOOP WHILE TIMER < start! + .25  'a bit



DO



 mainmenu

 wipe

 PALETTE



 SELECT CASE choice

  CASE 0

   ERROR 2: quitit

  CASE 1

   oneplayer

   mainloop

  CASE 2

   twoplayer

   mainloop

  CASE 3

   options

  CASE 4

   story

  CASE 5

   quitit

 END SELECT



LOOP



phrases:



'THE PHRASE DATA

'

'You want to make your own phrases? Just add to the DATA statements below.

'Don't make the new phrases more then 38 characters. And don't put any

'DATA statements below the "theend"!!! That will mess it up!!!



DATA "This is a cool game, eh?","Visit KeiProductions Online!"

DATA "I want QBasic 4.5!","I REALLY want QBasic 7.1!","You better guess this!"

DATA "QBasic is pretty cool.","This program is by Guardian Bob!"

DATA "The computer crash of 2000","Microsoft corporation"

DATA "You been on the QBasic Chat lately?","Disk Drive","VGA Monitor"

DATA "The Internet is cool!!!","Edmonton, Alberta is the BEST!"

DATA "Gravis Gamepad","I wish there was no school...","Dot-Matrix printer"

DATA "Happy birthday to...no one...","The doors on the bus go open and shut!"

DATA "A megabyte of RAM","A Pentium processor"

DATA "This game is like Hangman, but better!"

DATA "Internet explorer","Netscape navigator","high-density disk drive"

DATA "Scooby Doo, where are you?","Yabba Dabba Doo!!!","Did I do that?"

DATA "Remote control","Java is cool. Do you have it?"

DATA "SCREEN 13 is the best for games.","I can't think of any more phrases!"

DATA "ReBoot is a very cool show!","Beasties is a pretty cool show."

DATA "Have you had your a break today?","Did somebody say...McDonalds???"

DATA "Considered moving on to C++ after QB??"

DATA "What's your fave SCREEN? Mine's 13."

DATA "SVGA QBasic programs are cool!","Do you use INKEY$ of INP(&H60)?"

DATA "You can add your own phrases. Try it!","If only I had a brain..."

DATA "Hey, hey we're the Monkees!","CD ROM's are way better then disks!"



'DON'T PUT ANY DATA STATEMENTS BELOW THIS!!! PUT THEM ABOVE!



DATA "theend"





errorh:



CLS



COLOR 12: center "ERROR!!! ERROR!!! ERROR!!!", 2

PRINT

COLOR 30: center "There has been an error, code" + STR$(ERR) + ".", 5

center "Well, we'll just hope it doesn't happen", 7

center "again, won't we? Sure.", 9

center "This program is now terminating.", 11

center "Have a nice day.", 13

END



'  ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ

'  Û And that's the end of this program!  Remember to visit KeiProductions Û

'  Û    Online at http://fn2.freenet.edmonton.ab.ca/~djke/ and sign the    Û

'  Û   guestbook! Files, links, tutorials, and it's updated almost every   Û

'  Û                   day, if I find the time for it!                     Û

'  Û                                                                       Û

'  Û                          Happy programming!                           Û

'  Û                                                                       Û

'  Û                             Guardian Bob                              Û

'  ÛÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ



SUB border STATIC



IF isitnew = 1 THEN

 stage = 0

 isitnew = 0

END IF



IF stage = 0 THEN

  x! = 1: y! = 0: c = 32: stage = 1

ELSEIF stage = 1 THEN

  x! = x! + .2

  PSET (x!, 0), c

  IF INT(x!) = 319 THEN stage = 2

ELSEIF stage = 2 THEN

  y! = y! + .2

  PSET (x!, y!), c

  IF INT(y!) = 199 THEN stage = 3

ELSEIF stage = 3 THEN

  x! = x! - .2

  PSET (x!, y!), c

  IF INT(x!) = 0 THEN stage = 4

ELSEIF stage = 4 THEN

  y! = y! - .2

  PSET (x!, y!), c

  IF INT(y!) = 0 THEN stage = 5

ELSEIF stage = 5 THEN

  c = c + 2

  IF c = 90 THEN c = 32

  x! = 1

  stage = 1

END IF



END SUB



SUB center (text$, row)



LOCATE row, (20 - LEN(text$) / 2) + .8

PRINT text$;



END SUB



SUB changecolor (pal, r, g, b)



OUT &H3C8, pal

OUT &H3C9, r

OUT &H3C9, g

OUT &H3C9, b



END SUB



SUB colorandom



RANDOMIZE TIMER

c = INT(RND * 40) + 35

COLOR c



END SUB



SUB gameover



IF snd = 1 THEN PLAY "mb o0 c3"

FOR a = 1 TO 30

 CIRCLE (295, 78), a, 12

 FOR p = 1 TO 10000: NEXT p

NEXT a



LINE (2, 122)-(317, 197), 0, BF

COLOR 9

center "GAME OVER!!", 18

COLOR 15

center "You lose. The correct phrase is:", 20

center phrase$, 21

COLOR 12

center "Press any key...", 23

SLEEP

END SUB



SUB getcolor (pal, r, g, b)



OUT &H3C7, pal

r = INP(&H3C9)

g = INP(&H3C9)

b = INP(&H3C9)



END SUB



SUB getgraphics



PALETTE 1, 0

PALETTE 7, 0     'Change the colors

PALETTE 9, 0     'temporarily so you

PALETTE 12, 0    'can't see the car

PALETTE 14, 0    'getting drawn

PALETTE 15, 0



PSET (1, 20), 0

DRAW "c15 d5 f1 r44 e1 u5 h1 l6 h7 l24 g7"    'The outline of the car



CIRCLE (10, 26), 4         'The

LINE (7, 26)-(13, 26), 0   'back

PSET (10, 26), 15          'wheel



CIRCLE (35, 26), 4         'The

LINE (32, 26)-(38, 26), 0  'front

PSET (35, 26), 15          'wheel



PSET (37, 19), 15          'The front

DRAW "h5 l10 d5 r15"       'window



PSET (20, 19), 15          'The back

DRAW "u5 l10 g5 r15"       'window



PAINT (20, 20), 9, 15      'Blue fill



LINE (2, 25)-(5, 25), 1    'Darker lines

LINE (15, 25)-(30, 25), 1  'to show

LINE (40, 25)-(46, 25), 1  'shading



LINE (2, 24)-(3, 25), 7, BF     'Bumpers???

LINE (46, 24)-(44, 25), 7, BF   'Looks like it...



LINE (46, 21)-(44, 22), 14, BF  'Front headlight

LINE (2, 21)-(3, 22), 12, BF    'Back headlight



'Finally, GET the car into the array CAR



GET (1, 12)-(47, 29), car



CLS

PALETTE 12, 0

PALETTE 4, 0



LINE (0, 1)-(20, 50), 12, BF                                  'Drawing

FOR a = 1 TO 60 STEP 5: LINE (0, a)-(20, a), 4: NEXT a        'the

FOR a = 1 TO 50 STEP 10: LINE (2, a)-(2, a + 4), 4: NEXT a    'brick

FOR a = 6 TO 55 STEP 10: LINE (8, a)-(8, a + 4), 4: NEXT a    'wall

FOR a = 1 TO 50 STEP 10: LINE (14, a)-(14, a + 4), 4: NEXT a  '

FOR a = 6 TO 55 STEP 10: LINE (20, a)-(20, a + 4), 4: NEXT a  '



'Get the brick wall into the array BRWALL



GET (0, 1)-(20, 51), brwall



CLS        'Clear the screen, then set all the

PALETTE    'colors to their defualts...



END SUB    'Ooh, what could this be? You guessed it, it ends the SUB.



SUB mainloop



colorandom

center "Press any key when ready to start...", 12



WHILE INKEY$ = "": WEND



CLS



COLOR 15



LOCATE 2, (20 - LEN(phrase$) / 2) + .8



linex = (POS(0) * 8) - 8   'Get the X co-ordinate where the phrase

                           'starts. (Convert it from LOCATE numbers)



FOR a = 1 TO LEN(phrase$)

 IF MID$(phrase$, a, 1) = " " THEN GOTO nxta

 IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz", MID$(phrase$, a, 1)) THEN

  LINE (linex + 2, 14)-(linex + 6, 14), 15

  blanks = blanks + 1

  GOTO nxta            'I won't explain this whole [FOR...NEXT a] loop, due

 ELSE                  'to limited space. It's basically drawing the blanks.

  '

  LOCATE 2, ((20 - LEN(phrase$) / 2) + .8) + a - 1: PRINT MID$(phrase$, a, 1);

 END IF

nxta:

linex = linex + 8

NEXT a



LINE (1, 5)-(319, 18), 4, B   'Border around

LINE (0, 4)-(318, 17), 12, B  'the phrase



LINE (1, 34)-(319, 105), 1, B   'Border around

LINE (0, 33)-(318, 104), 9, B   'the moving car



LINE (1, 121)-(319, 199), 5, B   'Border around

LINE (0, 120)-(318, 198), 13, B  'the information



c = 29

FOR a = 1 TO 17 STEP 2

  LINE (2, a + 85)-(317, a + 86), c, BF

  SELECT CASE a

   CASE 3, 7, 11, 15

   c = c - 1

  END SELECT

NEXT a



PUT (297, 35), brwall, PSET



carx! = 5                      'The starting X of the car

triesleft = 5                  'Duh...your tries left...



COLOR 43

center "Guess a letter!!!", 17

COLOR 15



getletter:



COLOR 14

center "Tries left:" + STR$(triesleft), 22



COLOR 10

IF used$ = "" THEN

 center "Letters used: none", 24

ELSE

 center "  Letters used: " + used$ + "  ", 24

END IF



getk:

carx! = carx! + .2

PUT (carx!, 68), car, PSET

IF INT(carx!) = 250 THEN gameover: wipe: phrase$ = "": EXIT SUB

WAIT &H3DA, 8, 8: WAIT &H3DA, 8

LINE (carx!, 68)-(carx! + 46, 85), 0, BF



z$ = INKEY$

IF z$ = "" THEN GOTO getk



IF z$ = CHR$(27) THEN PUT (carx!, 68), car, PSET: wipe: EXIT SUB



IF INSTR("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ", z$) THEN



 IF INSTR(used$, z$) THEN GOTO getletter



 l1$ = LCASE$(z$)

 l2$ = UCASE$(z$)



 flag = 0

 FOR g = 1 TO LEN(phrase$)

  IF MID$(phrase$, g, 1) = l1$ THEN

   flag = 1

   LOCATE 2, ((20 - LEN(phrase$) / 2) + .8) - 1 + g

   COLOR 15: PRINT l1$;

   blanks = blanks - 1

  END IF

  IF MID$(phrase$, g, 1) = l2$ THEN

   flag = 1

   LOCATE 2, ((20 - LEN(phrase$) / 2) + .8) - 1 + g

   COLOR 15: PRINT l2$;

   blanks = blanks - 1

  END IF

 NEXT g



 used$ = used$ + l1$



 IF blanks = 0 THEN youwin: EXIT SUB

 IF flag = 1 THEN GOTO getletter



 IF snd = 1 THEN SOUND 50, 5

 triesleft = triesleft - 1

 IF triesleft = 0 THEN

  COLOR 10

  center "  Letters used: " + used$ + "  ", 24

  COLOR 14

  center "Tries left:" + STR$(triesleft), 22

  LINE (carx!, 68)-(carx! + 46, 85), 0, BF

  FOR a = carx! + 1 TO 250

   PUT (a, 68), car, PSET

    IF a < 250 THEN WAIT &H3DA, 8, 8: WAIT &H3DA, 8

    IF a < 250 THEN LINE (a, 68)-(a + 46, 85), 0, BF

  NEXT a

  gameover

  phrase$ = "": wipe

  EXIT SUB

 END IF

 GOTO getletter



END IF



GOTO getletter



END SUB



SUB mainmenu



ct$ = "G U E S S   T H A T   P H R A S E"  'Centered title text



choice = 0                                 'The choice selected

                                        

ct = (20 - LEN(ct$) / 2) + .8



FOR a = 1 TO LEN(ct$) STEP 2

  IF MID$(ct$, a, 1) = " " THEN a = a + 2

  FOR b = 1 TO 3

    IF b < 3 THEN COLOR 4 ELSE COLOR 12

    LOCATE b, ct - 1 + a: PRINT MID$(ct$, a, 1)

    FOR p = 1 TO 10000: NEXT p

    IF b < 3 THEN LOCATE b, ct - 1 + a: PRINT " "

  NEXT b

NEXT a



x = 319

y = 199



c(0) = 32



FOR a = 1 TO 5

 c(a) = c(0) + a

NEXT a



FOR a = 0 TO 5

 LINE (a, a)-(x, y), c(a), B

 x = x - 1: y = y - 1

NEXT a



PALETTE 15, 0: COLOR 15

center "1. Start a one-player game", 7

center "2. Start a two-player game", 10

center "3. View/change options    ", 13

center "4. Story                  ", 16

center "5. Quit!!                 ", 19

PALETTE 28, 0: COLOR 28: center "(C) 1998 KeiProductions", 24



c = 32

cl = 41

cc = 10



DO



IF cc < 63 THEN changecolor 15, cc, cc, cc

IF cc < 40 THEN changecolor 28, cc, cc, cc

IF cc < 63 THEN cc = cc + 1



LINE (24, 26)-(c, 26), cl



c = c + 1



FOR pause = 1 TO 10000    'Pause

NEXT pause                'a bit



IF c = 287 THEN cl = cl + 2: c = 32

IF cl = 99 THEN cl = 41



x = 319

y = 199



IF c MOD 3 = 0 THEN

 FOR a = 0 TO 5

  c(a) = c(a) + 1: IF c(a) = 100 THEN c(a) = 32

  LINE (a, a)-(x, y), c(a), B

  x = x - 1

  y = y - 1

 NEXT a

END IF



z$ = INKEY$

IF VAL(z$) > 0 AND VAL(z$) < 6 THEN EXIT DO

IF z$ = CHR$(27) THEN EXIT DO



LOOP



IF z$ = CHR$(27) THEN choice = 0 ELSE choice = VAL(z$)



END SUB



SUB oneplayer



'Adding your own phrases is easy. Add to the DATA statements, in the Main

'Module.



RESTORE phrases



DO

  READ count$

  IF count$ = "theend" THEN EXIT DO

  n = n + 1

LOOP



RANDOMIZE TIMER

r = INT(RND * n) + 1



RESTORE phrases



DO

  READ phrase$

  r = r - 1

  IF r = 0 THEN EXIT DO

LOOP



END SUB



SUB options



colorandom



ct$ = "O  P  T  I  O  N  S"

                                       

ct = (20 - LEN(ct$) / 2) + .8



FOR a = 1 TO LEN(ct$) STEP 3

  IF MID$(ct$, a, 1) = " " THEN a = a + 2

  FOR b = 1 TO 5

    IF b < 5 THEN COLOR 1 ELSE COLOR 9

    LOCATE b, ct - 1 + a: PRINT MID$(ct$, a, 1)

    FOR p = 1 TO 10000: NEXT p

    IF b < 5 THEN LOCATE b, ct - 1 + a: PRINT " "

  NEXT b

NEXT a



COLOR 15

center "[S]ound", 9

COLOR 29

IF snd = 1 THEN center "on ", 11 ELSE center "off", 11



COLOR 13: center "Press a key to change a value, or", 21

center "press Esc to return to the main menu.", 22



isitnew = 1



DO

waitfork:

 border

 z$ = INKEY$

 IF z$ = "" THEN GOTO waitfork

 IF z$ = "s" THEN

  IF snd = 1 THEN snd = 0 ELSE snd = 1

  COLOR 29

  IF snd = 1 THEN center "on ", 11 ELSE center "off", 11

 END IF

 IF z$ = CHR$(27) THEN EXIT DO

LOOP



wipe



END SUB



SUB quitit



PALETTE



SCREEN 0



SYSTEM



END SUB



SUB story



colorandom

center "GUESS THAT PHRASE - STORY", 2



COLOR 30

center "You've heard of Hangman, right? Well,", 4

center "it's a classic game. It's been made", 5

center "by KeiProductions, and that's where", 6

center "our story begins. Deep in Keith", 7

center "Koshman's computer, a Hangman lives.", 8

center "Sick and tired of getting hanged", 9

center "every time someone plays the game,", 10

center "he decides to take matters into his", 11

center "own hands. And a few days later, his", 12

center "creation is complete - the best game", 13

center "ever made (at least in QBasic). The", 14

center "Hangman sends the game into a QBasic", 15

center "page on the Internet (KeiProductions", 16

center "Online!) and jumps into his car...", 17

center "realizing he's still in a game!", 18

center "And this time it's not Hangman, but", 19

center "THE NEW GAME HE JUST CREATED!!!", 20

center "So start up this game, guess that", 21

center "phrase, and help the Hangman!", 22

COLOR 12

center "Press a key to return to the main menu", 24



isitnew = 1



WHILE INKEY$ = ""

 border

WEND



wipe



END SUB



SUB twoplayer



colorandom

center "T W O   P L A Y E R   G A M E", 2

COLOR 15

center "Player 1, enter the phrase.", 4



COLOR 13



isitnew = 1

phrase$ = ""

center "Û", 6



DO

waitforit:

 border

 z$ = INKEY$: IF z$ = "" THEN GOTO waitforit

 IF z$ = CHR$(13) THEN IF LEN(phrase$) = 0 THEN GOTO lop ELSE EXIT DO

 IF z$ = CHR$(8) THEN

  IF LEN(phrase$) > 0 THEN

   phrase$ = LEFT$(phrase$, LEN(phrase$) - 1): GOTO lop

  END IF

 END IF

 IF INSTR(" abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890!$#&,.:;'-+=()?", z$) THEN

  IF LEN(phrase$) = 35 THEN

   IF snd = 1 THEN SOUND 100, 1

   GOTO lop

  END IF

 phrase$ = phrase$ + z$

 END IF

lop:

center " " + phrase$ + "Û ", 6

LOOP



wipe



END SUB



SUB wipe

  

RANDOMIZE TIMER

r = INT(RND * 4) + 1



SELECT CASE r



CASE 1

x = 319



FOR a = 0 TO 319

LINE (0, 0)-(a, 199), 0

LINE (319, 199)-(x, 0), 0

x = x - 1



FOR p = 1 TO 2000: NEXT p



NEXT a



CLS



CASE 2

z = 319

FOR a = 0 TO 319

LINE (a, 0)-(a, 100), 0

LINE (z, 319)-(z, 100), 0

FOR p = 1 TO 1000: NEXT p

z = z - 1

NEXT a



CLS



CASE 3

FOR a = 200 TO 0 STEP -1

CIRCLE (160, 100), a, 0

CIRCLE (161, 101), a, 0

CIRCLE (159, 99), a, 0

CIRCLE (162, 100), a, 0

FOR p = 1 TO 800: NEXT p

NEXT a



CLS



CASE 4



'This is the cool fading routine!!!



DO

 bl = 1

 FOR a = 1 TO 255

  getcolor a, r, g, b

  IF r = 0 AND b = 0 AND g = 0 THEN bl = bl + 1

  r = r - 1: g = g - 1: b = b - 1

  IF r < 0 THEN r = 0

  IF g < 0 THEN g = 0

  IF b < 0 THEN b = 0

  changecolor a, r, g, b

  IF bl = 255 THEN EXIT DO

 NEXT a

LOOP



CLS

PALETTE



END SELECT



start! = TIMER

WHILE TIMER < start! + .1: WEND



END SUB



SUB youwin



IF snd = 1 THEN PLAY "o2 l10 gab>c5"



DO

colorandom

RANDOMIZE TIMER

a = INT(RND * 25) + 1

b = INT(RND * 33) + 1



LOCATE a, b: PRINT "YOU WIN!";



z$ = INKEY$

IF z$ <> "" THEN EXIT DO



FOR p = 1 TO 1000: NEXT p



LOOP



wipe



END SUB