'=========================================================================== ' Subject: HANGMAN GAME W/MOUSE CONTROL Date: 01-26-98 (22:55) ' Author: Lim Chang Meng Code: QB, QBasic, PDS ' Origin: comp.lang.basic.misc Packet: GAMES.ABC '=========================================================================== ' HANGMAN.BAS ' Written by Lim Chang Meng ' Email: limcmg@tm.net.my ' Commence: 23 June 1997 ' Completed : W-I-P ' Mouse portion of the codes taken from QMOUSE.BAS ' by Robert Wolf TV & Radio Service ' ' ' If you use QuickBASIC 4.5 need to load QB.LIB ' To run, launch QuickBASIC like this --> "QB.EXE /LQB" DEFINT A-Z '---------------------------------------------------------------------------- 'Declare constants '---------------------------------------------------------------------------- 'Constants have been declared to make the codes more readable CONST False = 0 'False CONST True = 1 'True CONST No = 0 'No confirmation from dialog CONST Yes = 1 'Yes confirmation from dialog CONST YesNo = 4 'Dialog with yes and no button CONST Okay = 5 'Dialog wih okay button CONST Notice = 6 'A dialog box with a message CONST MReset = 0 'Reset mouse value CONST MOn = 1 'Mouse pointer on value CONST MOff = 2 'Mouse pointer off value CONST MCoordinates = 3 'Get mouse coordinates value '---------------------------------------------------------------------------- 'Declare sub program '---------------------------------------------------------------------------- DECLARE SUB SetupScreen () DECLARE SUB DrawTitle () DECLARE SUB DialogBox (DialogType, Message$, Confirm) DECLARE SUB ButtonPress (PX1, PX2, PY1, PY2) DECLARE SUB Database (FullWord$, Meaning$) DECLARE SUB mouse (cx, dx, bx) DECLARE SUB MousePointer (SW) DECLARE SUB Intro () '---------------------------------------------------------------------------- 'Initialising Arrays '---------------------------------------------------------------------------- DIM Button(27) 'Array for alphabet buttons DIM Word(11) 'Array for word selected '---------------------------------------------------------------------------- 'Detect mouse presence '---------------------------------------------------------------------------- ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' * Mouse presence detection * ' * calls and code stolen from FIDO QuickBasic Sub * ' * John Rodgers * ' * Too Cool Fool * ' * Wizard Productions * ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * DEF SEG = 0 M.seg& = 256& * PEEK(207) + PEEK(206) M.info% = 256& * PEEK(205) + PEEK(204) + 2 ' see if a Mouse Driver is loaded DEF SEG = M.seg& IF (M.seg& OR (M.info% - 2)) AND PEEK(M.info% - 2) = 207 THEN CLS SCREEN 9 COLOR 10 LOCATE 1, 21 PRINT "QuickBASIC Hangman require mouse to run" COLOR 15 LOCATE 4, 30 PRINT "Mouse driver not found !" LOCATE 6, 31 PRINT "Load mouse and re-try" COLOR 14 LOCATE 20, 24 PRINT "Press any key to continue" COLOR 12 '} CIRCLE (320, 175), 70 '} Draw a red circle CIRCLE (320, 175), 55 '} PAINT (320, 130), 12 '} LINE (291, 135)-(319, 160), 15, BF '} LINE (321, 135)-(349, 160), 15, BF '} LINE (291, 162)-(349, 200), 15, BF '} Draw the mouse COLOR 15 '} CIRCLE (320, 200), 29 '} PAINT (320, 201), 15 '} COLOR 12 LINE (350, 138)-(275, 210) LINE (370, 138)-(295, 210) PAINT (320, 175), 12 BEEP DO A = A + 1 IF A = 1000 THEN B = B + 1 LOCATE 20, 49 + B COLOR 14 PRINT "." IF A = 1000 THEN A = 0 IF B = 8 THEN B = 0 LOCATE 20, 49: PRINT " " END IF LOOP WHILE INKEY$ = "" END END IF '---------------------------------------------------------------------------- 'Initialising the mouse routine '---------------------------------------------------------------------------- DIM SHARED A(9) 'Set up array for code DEF SEG = VARSEG(A(0)) 'Get array segment (nnnn: ) '(two 8 bit) FOR i = 0 TO 17 'length of DATA to READ r 'read POKE VARPTR(A(0)) + i, r 'into array/2 (nnnn:iiii) (one 8 bit) NEXT i 'until 17 '---------------------------------------------------------------------------- 'Machine Code '---------------------------------------------------------------------------- DATA &HB8,&H00,&H00 : ' mov AX,[n] [Swap code-(L),(H)] in AX DATA &H55 : ' push BP Save BP DATA &H8B,&HEC : ' mov BP,SP Get BP to c Seg DATA &HCD,&H33 : ' int 33 Interrupt 33 DATA &H92 : ' xchg AX,[reg] [Swap code-reg] in AX DATA &H8B,&H5E,&H06 : ' mov BX,[BP+6] Point to (variable) DATA &H89,&H07 : ' mov [BX],AX Put AX in (variable) DATA &H5D : ' pop BP Restore BP DATA &HCA,&H02,&H00 : ' ret 2 Far return '---------------------------------------------------------------------------- 'Initialising background music notes '---------------------------------------------------------------------------- m01$ = "O3 E4 D8 C4 C8 C4 D8 E4 E8 E8 D8 C8 D8 E8 D8 C4 O2 B8" m02$ = "O3 ML C2 C8 MN D8 E4 E8 E4 F8 G4 G8 G4 G8 G4 D8 D4 E8 ML D2" m03$ = "D8 MN G8 A4 F8 A4 F8 A8 O4 ML C4 C8 MN O3 B8 A8 G4 E8 G4 E8 G2" m04$ = "O3 E4 D8 C4 C8 C4 D8 E4 E8 E8 D8 C8 D8 E8" m05$ = "D8 C4 O2 B8 O3 ML C2 C8 MN" m06$ = "o2 f8 f8 f+8 f8 g+8 g+8 f+8 f4 f8 f+8 f8 o3 c#8 c#8 o2 b8 a#8" GuessWrong$ = "T250 O3 C#8 O2 B8 A#8" GuessRight$ = "T255 MN L16 O3 A#8 O4 C#8" Win$ = "T120 MN O3 L16 G >C E G4 E G1" Lose$ = "T120 MN O3 L16 G E G4" '---------------------------------------------------------------------------- 'The opening scene '---------------------------------------------------------------------------- SCREEN 9 '640 X 350, 16 colors CLS PALETTE 0, 7 PALETTE 8, 0 COLOR 8, 3 TIMER ON Display$ = "QuickBASIC Hangman " WordLength = LEN(Display$) FOR Row = 1 TO 23 FOR Column = 1 TO 80 WhichOne = WhichOne + 1 IF WhichOne > WordLength THEN WhichOne = 1 LOCATE Row, Column: PRINT MID$(Display$, WhichOne, 1) NEXT Column NEXT Row 'Play some background music PLAY "mb" 'play music in background PLAY ON 'enable PLAY error trapping All$ = "T200" + m01$ + m02$ + m03$ + m04$ + m05$ PLAY All$ CALL Intro '---------------------------------------------------------------------------- 'Setup the screen for game play '---------------------------------------------------------------------------- Progress = 0 GameCount = 0 Score = 0 CALL SetupScreen CALL DrawTitle GOSUB SetButton CALL Database(FullWord$, Meaning$) GOSUB PlayGame '---------------------------------------------------------------------------- 'Mouse set up '---------------------------------------------------------------------------- CALL MousePointer(MReset) 'Reset mouse CALL MousePointer(MOn) 'Turn pointer on CALL MousePointer(MCoordinates) 'Get coordinates '---------------------------------------------------------------------------- 'The Main Program Loop '---------------------------------------------------------------------------- DO k$ = INKEY$ IF k$ = CHR$(27) THEN GOSUB Done CALL mouse(cx, dx, bx) IF cx > 0 AND cx < 350 AND dx > 0 AND dx < 640 THEN Hint$ = " " IF cx > 120 AND cx < 145 THEN IF dx > 315 AND dx < 350 AND Button(1) = True THEN Hint$ = "Select A ? " IF dx > 355 AND dx < 390 AND Button(2) = True THEN Hint$ = "Select B ? " IF dx > 395 AND dx < 430 AND Button(3) = True THEN Hint$ = "Select C ? " IF dx > 435 AND dx < 470 AND Button(4) = True THEN Hint$ = "Select D ? " IF dx > 475 AND dx < 510 AND Button(5) = True THEN Hint$ = "Select E ? " IF dx > 515 AND dx < 550 AND Button(6) = True THEN Hint$ = "Select F ? " IF dx > 555 AND dx < 590 AND Button(7) = True THEN Hint$ = "Select G ? " ELSEIF cx > 162 AND cx < 187 THEN IF dx > 315 AND dx < 350 AND Button(8) = True THEN Hint$ = "Select H ? " IF dx > 355 AND dx < 390 AND Button(9) = True THEN Hint$ = "Select I ? " IF dx > 395 AND dx < 430 AND Button(10) = True THEN Hint$ = "Select J ? " IF dx > 435 AND dx < 470 AND Button(11) = True THEN Hint$ = "Select K ? " IF dx > 475 AND dx < 510 AND Button(12) = True THEN Hint$ = "Select L ? " IF dx > 515 AND dx < 550 AND Button(13) = True THEN Hint$ = "Select M ? " IF dx > 555 AND dx < 590 AND Button(14) = True THEN Hint$ = "Select N ? " ELSEIF cx > 204 AND cx < 229 THEN IF dx > 315 AND dx < 350 AND Button(15) = True THEN Hint$ = "Select O ? " IF dx > 355 AND dx < 390 AND Button(16) = True THEN Hint$ = "Select P ? " IF dx > 395 AND dx < 430 AND Button(17) = True THEN Hint$ = "Select Q ? " IF dx > 435 AND dx < 470 AND Button(18) = True THEN Hint$ = "Select R ? " IF dx > 475 AND dx < 510 AND Button(19) = True THEN Hint$ = "Select S ? " IF dx > 515 AND dx < 550 AND Button(20) = True THEN Hint$ = "Select T ? " IF dx > 555 AND dx < 590 AND Button(21) = True THEN Hint$ = "Select U ? " ELSEIF cx > 246 AND cx < 271 THEN IF dx > 315 AND dx < 350 AND Button(22) = True THEN Hint$ = "Select V ? " IF dx > 355 AND dx < 390 AND Button(23) = True THEN Hint$ = "Select W ? " IF dx > 395 AND dx < 430 AND Button(24) = True THEN Hint$ = "Select X ? " IF dx > 435 AND dx < 470 AND Button(25) = True THEN Hint$ = "Select Y ? " IF dx > 475 AND dx < 510 AND Button(26) = True THEN Hint$ = "Select Z ? " END IF 'The control buttons IF cx > 300 AND cx < 330 THEN IF dx > 300 AND dx < 400 THEN Hint$ = "Play new game ? " IF dx > 405 AND dx < 505 THEN Hint$ = "Want some hint ?" IF dx > 510 AND dx < 610 THEN Hint$ = "Exit the game ? " END IF 'The Hangman box IF cx > 80 AND cx < 340 AND dx > 30 AND dx < 280 THEN Hint$ = "The Hangman ! " 'The hint box IF cx > 30 AND cx < 65 AND dx > 295 AND dx < 615 THEN Hint$ = "" COLOR 15: LOCATE 4, 40: PRINT Hint$ 'Filter a 1 for Left IF bx = 1 THEN IF cx > 120 AND cx < 145 THEN PY1 = 120 PY2 = 145 IF dx > 315 AND dx < 350 AND Button(1) = True THEN Letter = 1 GOSUB TestGuess END IF IF dx > 355 AND dx < 390 AND Button(2) = True THEN Letter = 2 GOSUB TestGuess END IF IF dx > 395 AND dx < 430 AND Button(3) = True THEN Letter = 3 GOSUB TestGuess END IF IF dx > 435 AND dx < 470 AND Button(4) = True THEN Letter = 4 GOSUB TestGuess END IF IF dx > 475 AND dx < 510 AND Button(5) = True THEN Letter = 5 GOSUB TestGuess END IF IF dx > 515 AND dx < 550 AND Button(6) = True THEN Letter = 6 GOSUB TestGuess END IF IF dx > 555 AND dx < 590 AND Button(7) = True THEN Letter = 7 GOSUB TestGuess END IF ELSEIF cx > 162 AND cx < 187 THEN PY1 = 162 PY2 = 187 IF dx > 315 AND dx < 350 AND Button(8) = True THEN Letter = 8 GOSUB TestGuess END IF IF dx > 355 AND dx < 390 AND Button(9) = True THEN Letter = 9 GOSUB TestGuess END IF IF dx > 395 AND dx < 430 AND Button(10) = True THEN Letter = 10 GOSUB TestGuess END IF IF dx > 435 AND dx < 470 AND Button(11) = True THEN Letter = 11 GOSUB TestGuess END IF IF dx > 475 AND dx < 510 AND Button(12) = True THEN Letter = 12 GOSUB TestGuess END IF IF dx > 515 AND dx < 550 AND Button(13) = True THEN Letter = 13 GOSUB TestGuess END IF IF dx > 555 AND dx < 590 AND Button(14) = True THEN Letter = 14 GOSUB TestGuess END IF ELSEIF cx > 204 AND cx < 229 THEN PY1 = 204 PY2 = 229 IF dx > 315 AND dx < 350 AND Button(15) = True THEN Letter = 15 GOSUB TestGuess END IF IF dx > 355 AND dx < 390 AND Button(16) = True THEN Letter = 16 GOSUB TestGuess END IF IF dx > 395 AND dx < 430 AND Button(17) = True THEN Letter = 17 GOSUB TestGuess END IF IF dx > 435 AND dx < 470 AND Button(18) = True THEN Letter = 18 GOSUB TestGuess END IF IF dx > 475 AND dx < 510 AND Button(19) = True THEN Letter = 19 GOSUB TestGuess END IF IF dx > 515 AND dx < 550 AND Button(20) = True THEN Letter = 20 GOSUB TestGuess END IF IF dx > 555 AND dx < 590 AND Button(21) = True THEN Letter = 21 GOSUB TestGuess END IF ELSEIF cx > 246 AND cx < 271 THEN PY1 = 246 PY2 = 271 IF dx > 315 AND dx < 350 AND Button(22) = True THEN Letter = 22 GOSUB TestGuess END IF IF dx > 355 AND dx < 390 AND Button(23) = True THEN Letter = 23 GOSUB TestGuess END IF IF dx > 395 AND dx < 430 AND Button(24) = True THEN Letter = 24 GOSUB TestGuess END IF IF dx > 435 AND dx < 470 AND Button(25) = True THEN Letter = 25 GOSUB TestGuess END IF IF dx > 475 AND dx < 510 AND Button(26) = True THEN Letter = 26 GOSUB TestGuess END IF END IF ' The control buttons IF cx > 300 AND cx < 330 THEN IF dx > 300 AND dx < 400 THEN ' Depress the button when pressed PX1 = 300 'Set PY1 = 300 'coordinates PX2 = 400 'to depress PY2 = 330 'button when pressed CALL ButtonPress(PX1, PX2, PY1, PY2) 'Depress button GameCount = GameCount - 1 'Don't count 'uncompleted game GOSUB LoadNewGame 'Prepare for new game END IF IF dx > 405 AND dx < 505 THEN GOSUB Hint END IF IF dx > 510 AND dx < 610 THEN PX1 = 510 'Set PY1 = 300 'coordinates PX2 = 610 'to depress PY2 = 330 'button when pressed CALL ButtonPress(PX1, PX2, PY1, PY2) 'Depress button GOSUB Done END IF END IF END IF LOOP '---------------------------------------------------------------------------- 'Initialise Screen '---------------------------------------------------------------------------- SetButton: WrongGuess = 0 RightGuess = 0 TotalLetters = 0 LX1 = 0 LX2 = 0 LY1 = 0 LY2 = 0 FOR CountLetter = 1 TO 27 Button(CountLetter) = True NEXT CountLetter RETURN '---------------------------------------------------------------------------- 'Allocating the word for guessing '---------------------------------------------------------------------------- PlayGame: 'Allocating guess word for game play LocX = 16 FOR WordCount = 1 TO LEN(FullWord$) Word(WordCount) = ASC(UCASE$(MID$(FullWord$, WordCount, 1))) LOCATE 4, LocX: PRINT "_" LocX = LocX + 2 NEXT WordCount RETURN '---------------------------------------------------------------------------- 'Test for alphabet selected '---------------------------------------------------------------------------- TestGuess: Hit = 0 Button(Letter) = False 'Deactivated the selected buttons Alphabet = 64 + Letter 'Detect the alphabet selected 'Testing for button positions to set coordinates to be erased OriginPX1 = 315 OriginPX2 = 350 FOR ButtonLocation = 1 TO 7 IF dx > OriginPX1 AND dx < OriginPX2 THEN PX1 = OriginPX1 PX2 = OriginPX2 END IF OriginPX1 = OriginPX1 + 40 OriginPX2 = OriginPX2 + 40 NEXT ButtonLocation CALL MousePointer(MOff) 'Mouse pointer off before erasing 'the button CALL ButtonPress(PX1, PX2, PY1, PY2) 'Button pressed effect LINE (PX1, PY1)-(PX2, PY2), 7, BF 'Erase the button CALL MousePointer(MOn) 'Turn mouse pointer on after erase CALL MousePointer(MCoordinates) 'Get coordinates PX1 = -1 PX2 = -1 PY1 = -1 PY2 = -1 COLOR 14 LocX = 16 FOR WordCount = 1 TO LEN(FullWord$) IF Word(WordCount) = Alphabet THEN Hit = Hit + 1 RightGuess = RightGuess + 1 IF RightGuess < LEN(FullWord$) THEN PLAY GuessRight$ LOCATE 4, LocX: PRINT CHR$(Alphabet) END IF LocX = LocX + 2 NEXT COLOR 4 LOCATE 6, 5 PRINT " That was a good try " IF RightGuess = LEN(FullWord$) THEN COLOR 4: LOCATE 6, 5: PRINT " " Score = Score + 1 PLAY Win$ CALL DialogBox(Okay, "You got it !", Confirm) GOSUB AnotherGame RightGuess = 0 END IF IF Hit = 0 THEN GOSUB DrawHangman RETURN '---------------------------------------------------------------------------- 'Draw Hangman '---------------------------------------------------------------------------- DrawHangman: WrongGuess = WrongGuess + 1 'Keep track of wrong guesses COLOR 4 'Set hangman text indicator COLOR LOCATE 6, 5 'Set hangman text indicator position SELECT CASE WrongGuess '+-------------------------------------------------+ '| First wrong guess - draw a yellow "face" | '+-------------------------------------------------+ CASE 1 PRINT " Oops! Be careful! " FOR A = 1 TO 6 IF A = 1 OR A = 6 THEN CIRCLE (150, 140), (29 + A), 8 ELSEIF A = 2 OR A = 5 THEN CIRCLE (150, 140), (29 + A), 6 ELSE CIRCLE (150, 140), (29 + A), 14 END IF NEXT A PLAY GuessWrong$ '+-------------------------------------------------+ '| Second wrong guess - draw a green body | '+-------------------------------------------------+ CASE 2 PRINT " Not again ? " LINE (147, 167)-(153, 240), 10, BF LINE (148, 168)-(152, 239), 2, B LINE (147, 167)-(153, 240), 8, B PLAY GuessWrong$ '+-------------------------------------------------+ '| Third wrong guess - draw the right hand | '+-------------------------------------------------+ CASE 3 PRINT " Wrong guess again " FOR A = 1 TO 6 IF A = 1 OR A = 6 THEN LINE (147, 170 + A)-(70, 220 + A), 8 ELSEIF A = 2 OR A = 5 THEN LINE (147, 170 + A)-(70, 220 + A), 2 ELSE LINE (147, 170 + A)-(70, 220 + A), 10 END IF NEXT A LINE (70, 221)-(70, 226), 8 LINE (71, 221)-(71, 225), 2 PLAY GuessWrong$ '+-------------------------------------------------+ '| Fourth wrong guess - draw the left hand | '+-------------------------------------------------+ CASE 4 ' The green right hand PRINT "Your chances are getting slim" FOR A = 1 TO 6 IF A = 1 OR A = 6 THEN LINE (153, 170 + A)-(221, 220 + A), 8 ELSEIF A = 2 OR A = 5 THEN LINE (153, 170 + A)-(221, 220 + A), 2 ELSE LINE (153, 170 + A)-(221, 220 + A), 10 END IF NEXT A LINE (221, 221)-(221, 226), 8 LINE (220, 221)-(220, 225), 2 PLAY GuessWrong$ '+-------------------------------------------------+ '| Fifth wrong guess - draw the left leg | '+-------------------------------------------------+ CASE 5 ' The green left leg PRINT " Use your brains fast! " FOR A = 1 TO 8 IF A = 1 OR A = 8 THEN LINE (150, 235 + A)-(98, 305 + A), 8 ELSEIF A = 2 OR A = 7 THEN LINE (150, 235 + A)-(98, 305 + A), 2 ELSE LINE (150, 235 + A)-(98, 305 + A), 10 END IF NEXT A LINE (149, 236)-(151, 242), 10, BF PLAY GuessWrong$ '+-------------------------------------------------+ '| Sixth wrong guess - draw the right leg | '+-------------------------------------------------+ CASE 6 ' The green right leg PRINT " Danger ! Danger ! " FOR A = 1 TO 8 IF A = 1 OR A = 8 THEN LINE (150, 235 + A)-(201, 305 + A), 8 ELSEIF A = 2 OR A = 7 THEN LINE (150, 235 + A)-(201, 305 + A), 2 ELSE LINE (150, 235 + A)-(201, 305 + A), 10 END IF NEXT A LINE (149, 236)-(151, 242), 10, BF PLAY GuessWrong$ '+-------------------------------------------------+ '| Seventh wrong guess - draw a rope | '+-------------------------------------------------+ CASE 7 ' The brown rope PRINT " MAYDAY ! MAYDAY ! " LINE (147, 113)-(153, 100), 6, BF LINE (147, 113)-(153, 100), 8, B LINE (148, 112)-(152, 101), 5, B PLAY GuessWrong$ '+-------------------------------------------------+ '| Eighth wrong guess - draw the top pole | '+-------------------------------------------------+ CASE 8 ' The brown top pole PRINT " You need a miracle! " LINE (50, 95)-(260, 100), 6, BF LINE (50, 95)-(260, 100), 8, B LINE (51, 96)-(259, 99), 5, B PLAY m06$ SLEEP 1 '+-------------------------------------------------+ '| Ninth wrong guess - draw the verticle pole | '+-------------------------------------------------+ CASE 9 ' The brown verticle beam PRINT " " FOR A = 1 TO 3600 LINE (255, 100 + (A / 16))-(260, 100 + (A / 16)) NEXT A FOR B = 1 TO 3600 NEXT B LINE (255, 100)-(260, 325), 6, BF LINE (255, 95)-(260, 325), 8, B LINE (256, 96)-(259, 324), 5, B PLAY Lose$ 'Play the "losing" tune CALL DialogBox(Okay, "Oops! you're hung!", Confirm) 'A dialog box 'to tell the 'player he lost GOSUB AnotherGame 'Ask whether want to play a new game END SELECT RETURN '---------------------------------------------------------------------------- 'Another game '---------------------------------------------------------------------------- AnotherGame: CALL DialogBox(YesNo, "Another game ?", Confirm) 'Display decision dialog 'to determine whether 'player want to continue IF Confirm = Yes THEN 'If player want to play PLAY "T200" + m04$ + m05$ 'Play some background 'music while loading CALL DialogBox(Notice, "Okay get ready !", Confirm) 'Tell the player 'new game is loading GameCount = GameCount + 1 'Number of games played CALL SetupScreen 'Redraw the screen CALL DrawTitle 'Redraw the title GOSUB SetButton 'Reset the buttons CALL Database(FullWord$, Meaning$) 'Select a word GOSUB PlayGame 'Prepare to play GOSUB GameStatus 'Display game status SLEEP 1 'Delay for a second ELSE 'If player wish to stop CALL MousePointer(MOn) 'Turn mouse pointer on CALL MousePointer(MCoordinates) 'Get coordinates GOSUB Done 'Ask if player want to quit '+----------------------------------------------------------+ '| If player didn't end the game, then disable all alphabet | '| buttons and erase hangman picture | '+----------------------------------------------------------+ CALL MousePointer(MOff) 'Turn mouse pointer off FOR CountLetter = 1 TO 27 'Disable Button(CountLetter) = False 'all alphabet NEXT CountLetter 'buttons LINE (32, 90)-(278, 338), 3, BF 'Clear hangman box LINE (302, 107)-(606, 283), 7, BF 'Erase all alphabet buttons LOCATE 6, 5 'Erase the hangman PRINT " " 'text indicator CALL MousePointer(MOn) 'Turn mouse pointer on CALL MousePointer(MCoordinates) 'Get coordinates END IF CALL MousePointer(MOn) 'Turn mouse pointer on CALL MousePointer(MCoordinates) 'Get coordinates RETURN '---------------------------------------------------------------------------- 'Load New Game '---------------------------------------------------------------------------- LoadNewGame: CALL DialogBox(YesNo, "Load new game ?", Confirm) 'Display decision dialog IF Confirm = Yes THEN 'Clear the screen and indicate loading of new game PLAY "T200" + m04$ + m05$ CALL DialogBox(Notice, "Loading new game", Confirm) GameCount = GameCount + 1 CALL SetupScreen CALL DrawTitle GOSUB SetButton CALL Database(FullWord$, Meaning$) GOSUB PlayGame GOSUB GameStatus SLEEP 1 'Set some delay END IF CALL MousePointer(MOn) 'Turn mouse pointer on CALL MousePointer(MCoordinates) 'Get coordinates RETURN '---------------------------------------------------------------------------- 'Display game status '---------------------------------------------------------------------------- GameStatus: 'Tell the player of the status with the following considerations:- ' 1. Check for grammar ' 2. Don't display status in the first game IF GameCount < 2 THEN TotalGame$ = "game" ELSE TotalGame$ = "games" IF Score < 2 THEN TotalScore$ = "word" ELSE TotalScore$ = "words" COLOR 8 IF GameCount > 0 THEN LOCATE 6, 40: PRINT "You managed to get"; Score; TotalScore$; " " LOCATE 7, 40: PRINT "correct out of"; GameCount; TotalGame$; " played" END IF RETURN '---------------------------------------------------------------------------- 'Hint '---------------------------------------------------------------------------- Hint: PX1 = 405 PY1 = 300 PX2 = 505 PY2 = 330 CALL ButtonPress(PX1, PX2, PY1, PY2) CALL MousePointer(MOff) 'Turn mouse pointer off FOR A = 0 TO 639 FOR B = 1 TO 1000 ' set some delay NEXT B LINE (639, 0)-(639 - A, 30), 7, BF LINE (0, 0)-(A, 30), 7, BF NEXT A COLOR 8: LOCATE 1, ((80 - 4) / 2): PRINT "Hint" COLOR 10: LOCATE 2, ((80 - LEN(Meaning$)) / 2) + 1 PRINT MID$(Meaning$, 1, 80) SLEEP 3 'Redraw the title with style! FOR A = 0 TO 315 LINE (320 + A, 3)-(320 + A, 29), 1 LINE ((320 - A), 3)-((320 - A), 29), 1 LINE (320 + A, 2)-(320 + A, 2), 8 LINE (320 - A, 2)-(320 - A, 2), 8 LINE ((320 - A), 30)-((320 - A), 30), 15 LINE ((320 + A), 30)-((320 + A), 30), 15 FOR B = 1 TO 1000 ' set some delay NEXT B NEXT A CALL DrawTitle CALL MousePointer(MOn) 'Turn mouse pointer on CALL MousePointer(MCoordinates) 'Set coordinates RETURN '---------------------------------------------------------------------------- 'Exit '---------------------------------------------------------------------------- Done: CALL DialogBox(YesNo, "You want to quit ?", Confirm) 'Display decision dialog IF Confirm = No THEN CALL MousePointer(MOn) CALL MousePointer(MCoordinates) ELSE CALL DialogBox(Notice, "Thanks for playing", Confirm) COLOR 7, 0 CLS SCREEN 0 DEF SEG END END IF RETURN SUB ButtonPress (PX1, PX2, PY1, PY2) ' Draw the control buttons LINE (PX1, PY1)-(PX2, PY1), 8 LINE (PX1, PY1)-(PX1, PY2), 8 LINE (PX1, PY2)-(PX2, PY2), 15 LINE (PX2, PY1)-(PX2, PY2), 15 Start! = TIMER DO Finish! = TIMER LOOP UNTIL Finish! - Start! > .2 LINE (PX1, PY1)-(PX2, PY1), 15 LINE (PX1, PY1)-(PX1, PY2), 15 LINE (PX1, PY2)-(PX2, PY2), 8 LINE (PX2, PY1)-(PX2, PY2), 8 Start! = TIMER DO Finish! = TIMER LOOP UNTIL Finish! - Start! > .3 END SUB SUB Database (FullWord$, Meaning$) '---------------------------------------------------------------------------- 'Initialising database of word for selection '---------------------------------------------------------------------------- RANDOMIZE TIMER 'Initialise randomiser GuessWord = INT(RND * 210) + 1 'Generate a random number SELECT CASE GuessWord CASE 1 FullWord$ = "Aberrant" Meaning$ = "Showing aberration" CASE 2 FullWord$ = "Abjure" Meaning$ = "Renounce on oath" CASE 3 FullWord$ = "Abnegate" Meaning$ = "Renounce, deny oneself" CASE 4 FullWord$ = "Abrade" Meaning$ = "Scrape off, injure by rubbing" CASE 5 FullWord$ = "Abrogate" Meaning$ = "Repeal, cancel" CASE 6 FullWord$ = "Abysmal" Meaning$ = "Bottomless or very bad" CASE 7 FullWord$ = "Abccede" Meaning$ = "Enter upon office, come to throne" CASE 8 FullWord$ = "Accost" Meaning$ = "Approach and speak to" CASE 9 FullWord$ = "Accoutred" Meaning$ = "Eqquiped, attired" CASE 10 FullWord$ = "Acrylic" Meaning$ = "Colourless organic liquid" CASE 11 FullWord$ = "Admix" Meaning$ = "Add as ingredient" CASE 12 FullWord$ = "Agog" Meaning$ = "Eager, expectant" CASE 13 FullWord$ = "Alb" Meaning$ = "White vestment reaching to feet worn by priest etc" CASE 14 FullWord$ = "Animadvert" Meaning$ = "Pass criticism or censure on" CASE 15 FullWord$ = "Anorak" Meaning$ = "Weatherproof jacket with hood" CASE 16 FullWord$ = "Apropos" Meaning$ = "To the point or purpose, incidentally" CASE 17 FullWord$ = "Arraign" Meaning$ = "Indict, accuse, find fault with" CASE 18 FullWord$ = "Arpeggio" Meaning$ = "Sounding of notes of chord in rapid succession" CASE 19 FullWord$ = "Atavism" Meaning$ = "Resemblance to remote ancestors" CASE 20 FullWord$ = "Auburn" Meaning$ = "Reddish brown" CASE 21 FullWord$ = "Bagatelle" Meaning$ = "Game like billiards played with small balls on inclined board with holes" CASE 22 FullWord$ = "Bailiff" Meaning$ = "Sheriff's officer who distrains or arrests" CASE 23 FullWord$ = "Baldric" Meaning$ = "A belt for sword, bugle etc. hung from shoulder to opposite hip" CASE 24 FullWord$ = "Ballyhoo" Meaning$ = "Vulgar or misleading publicity" CASE 25 FullWord$ = "Baluster" Meaning$ = "A short pillar with curving outline, a post supporting rail" CASE 26 FullWord$ = "Barathea" Meaning$ = "A fine wool cloth" CASE 27 FullWord$ = "Barbican" Meaning$ = "Outer defence to city or castle, example double tower over gate or bridge" CASE 28 FullWord$ = "Befuddle" Meaning$ = "Make drunk or confuse" CASE 29 FullWord$ = "Bravura" Meaning$ = "Brilliant or ambitious performance" CASE 30 FullWord$ = "Bunion" Meaning$ = "Inflamed swelling on foot, especially on big toe" CASE 31 FullWord$ = "Cadaverous" Meaning$ = "Corpse-like" CASE 32 FullWord$ = "Cadge" Meaning$ = "Try to get something by begging" CASE 33 FullWord$ = "Calico" Meaning$ = "Cotton cloth especially plain white one" CASE 34 FullWord$ = "Callosity" Meaning$ = "Hardness of skin" CASE 35 FullWord$ = "Calyx" Meaning$ = "Whorl of leaves called sepals forming outer case of bud" CASE 36 FullWord$ = "Captious" Meaning$ = "Fond of finding fault" CASE 37 FullWord$ = "Carillon" Meaning$ = "Tune played on set of bells sounded mechanically or from keyboard" CASE 38 FullWord$ = "Casuist" Meaning$ = "Theologian who studies and resolves cases of conscience" CASE 39 FullWord$ = "Castanet" Meaning$ = "A pair of handheld small concave wooden/ivory shells, clicked during dancing" CASE 40 FullWord$ = "Catarrh" Meaning$ = "Inflamation of mucous membrane" CASE 41 FullWord$ = "Catharsis" Meaning$ = "Purgation, outlet to emotion afforded by drama" CASE 42 FullWord$ = "Chartreuse" Meaning$ = "Green or yellow liqueur of brandy" CASE 43 FullWord$ = "Chatelaine" Meaning$ = "Appendage to woman's belt for carrying keys" CASE 44 FullWord$ = "Chilblain" Meaning$ = "Itching sore on hand, foot, etc caused by exposure to cold" CASE 45 FullWord$ = "Cipher" Meaning$ = "Arithmetical symbol 0, worthless person/thing, any Arabic numeral" CASE 46 FullWord$ = "Coalesce" Meaning$ = "Come together to form one, combine in coalition" CASE 47 FullWord$ = "Decrepit" Meaning$ = "Enfeebled with age, infirm, dilapidated" CASE 48 FullWord$ = "Deliquesce" Meaning$ = "Become liquid especially by absorbing moisture from the air" CASE 49 FullWord$ = "Denarius" Meaning$ = "Ancient Roman silver coin" CASE 50 FullWord$ = "Diatribe" Meaning$ = "Bitter criticism or denunciation" CASE 51 FullWord$ = "Ensnare" Meaning$ = "Entrap" CASE 52 FullWord$ = "Etiolate" Meaning$ = "Make pale by excluding light" CASE 53 FullWord$ = "Excogitate" Meaning$ = "Think out or devise" CASE 54 FullWord$ = "Finesse" Meaning$ = "Subtle management, artfulness" CASE 55 FullWord$ = "Flummox" Meaning$ = "Bewilder" CASE 56 FullWord$ = "Gaberdine" Meaning$ = "A strong twilled cloth" CASE 57 FullWord$ = "Gherkin" Meaning$ = "Young or small cucumber for picking" CASE 58 FullWord$ = "Gravamen" Meaning$ = "Essence or worst part of accusation" CASE 59 FullWord$ = "Gyrate" Meaning$ = "Move in circle or spiral" CASE 60 FullWord$ = "Halcyon" Meaning$ = "Peaceful, quite, happy, prosperous" CASE 61 FullWord$ = "Halitosis" Meaning$ = "Bad or foul breath" CASE 62 FullWord$ = "Zabalione" Meaning$ = "Italian sweet of whipped and heated egg yolks, sugar and wine" CASE 63 FullWord$ = "Queasy" Meaning$ = "Inclined to sickness or nausea, liable to qualms or scruples" CASE 64 FullWord$ = "Leveret" Meaning$ = "Young hare" CASE 65 FullWord$ = "Ombudsman" Meaning$ = "Official appointed to investigate individuals' complaints on public authorities" CASE 66 FullWord$ = "Interstice" Meaning$ = "Chink, crevice, gap" CASE 67 FullWord$ = "Inveigh" Meaning$ = "Speak violently, rail against" CASE 68 FullWord$ = "Inveigle" Meaning$ = "Entice, tempt into" CASE 69 FullWord$ = "Irascible" Meaning$ = "Irritable, hot-tempered" CASE 70 FullWord$ = "Isthmus" Meaning$ = "Neck of land, narrow connecting part" CASE 71 FullWord$ = "Jacinth" Meaning$ = "Tropical American tree with hard scented wood" CASE 72 FullWord$ = "Janitor" Meaning$ = "Doorkeeper, caretaker of building" CASE 73 FullWord$ = "Jape" Meaning$ = "Practical joke" CASE 74 FullWord$ = "Jerkin" Meaning$ = "Sleeveless jacket" CASE 75 FullWord$ = "Jodhpurs" Meaning$ = "Long breeches for riding, tight from knee to ankle" CASE 76 FullWord$ = "Jointure" Meaning$ = "Estate settled on wife for period during which she survives husband" CASE 77 FullWord$ = "Jut" Meaning$ = "Protrude, projection" CASE 78 FullWord$ = "Kibbutz" Meaning$ = "Communal especially farming settlement in Isreal" CASE 79 FullWord$ = "khaki" Meaning$ = "Dull brownish yellow" CASE 80 FullWord$ = "Landau" Meaning$ = "A kind of four-wheeled horse-drawn carriage" CASE 81 FullWord$ = "Libation" Meaning$ = "Drink-offering to god, toast drinking" CASE 82 FullWord$ = "Liana" Meaning$ = "A type of climbing and twining plant in tropical forrest" CASE 83 FullWord$ = "Luscious" Meaning$ = "Richly sweet in taste or smell, voluptuously attractive" CASE 84 FullWord$ = "Maelstrom" Meaning$ = "A great whirlpool" CASE 85 FullWord$ = "Maunder" Meaning$ = "Takl rambling" CASE 86 FullWord$ = "Mezzotint" Meaning$ = "Kind of copper or steel engraving" CASE 87 FullWord$ = "Mimesis" Meaning$ = "Close resemblance of an animal to another distasteful or harmful to predators" CASE 88 FullWord$ = "Minion" Meaning$ = "Favourite child, courtier etc or servile agent or slave" CASE 90 FullWord$ = "Minutia" Meaning$ = "Trivial point, small detail" CASE 91 FullWord$ = "Minx" Meaning$ = "Pert or shy girl" CASE 92 FullWord$ = "Nacre" Meaning$ = "Mother of pearl" CASE 93 FullWord$ = "Nark" Meaning$ = "Police spy, informer" CASE 94 FullWord$ = "Nictitate" Meaning$ = "Blink, wink" CASE 95 FullWord$ = "Nitwit" Meaning$ = "Stupid person" CASE 96 FullWord$ = "Nuxvomica" Meaning$ = "Seed yielding strychnine" CASE 97 FullWord$ = "Oaf" Meaning$ = "Awkward lout" CASE 98 FullWord$ = "Oblate" Meaning$ = "Dedicated person or flattened at poles" CASE 99 FullWord$ = "Omphalos" Meaning$ = "Centre, hub" CASE 100 FullWord$ = "Onyx" Meaning$ = "Kind of chalcedony with coloured layers" CASE 101 FullWord$ = "Orifice" Meaning$ = "Mouth of cavity, aperture" CASE 102 FullWord$ = "Osseous" Meaning$ = "Bony, having bones" CASE 103 FullWord$ = "Oxymoron" Meaning$ = "Figure of speech with pointed conjunction of apparent contradictions" CASE 104 FullWord$ = "Oyez" Meaning$ = "Uttered by public crier or court officer to call for attention" CASE 105 FullWord$ = "Oxalic" Meaning$ = "Intensely sour poisonous acid found in wood sorrel and other plants" CASE 106 FullWord$ = "Parsimony" Meaning$ = "Carefulness in employment of money etc" CASE 107 FullWord$ = "Pastille" Meaning$ = "Kind of small sweet especially medicated" CASE 108 FullWord$ = "Pauper" Meaning$ = "Very poor person" CASE 109 FullWord$ = "Perky" Meaning$ = "Self-assertive, jaunty" CASE 110 FullWord$ = "Pfennig" Meaning$ = "Small German coin worth 1/100 of a Mark" CASE 111 FullWord$ = "Pharynx" Meaning$ = "Cavity behind mouth and nose" CASE 112 FullWord$ = "Phlox" Meaning$ = "Plant with clusters of white or coloured flowers" CASE 113 FullWord$ = "Quixotic" Meaning$ = "Idealistic but impracticable, foolishly or absurdly generous, chivalrous" CASE 114 FullWord$ = "Quotient" Meaning$ = "Result given by dividing one quantity by another" CASE 115 FullWord$ = "Quisling" Meaning$ = "Collaborator with invading enemy" CASE 116 FullWord$ = "Aback" Meaning$ = "Disconcerted, surprised" CASE 117 FullWord$ = "Abaft" Meaning$ = "In or towards stern of ship" CASE 118 FullWord$ = "Abdicate" Meaning$ = "Renounce or resign from" CASE 119 FullWord$ = "Abdomen" Meaning$ = "Belly, rear part of insect" CASE 120 FullWord$ = "Abduct" Meaning$ = "Carry off illegally, kidnap" CASE 121 FullWord$ = "Abide" Meaning$ = "Tolerate, keep (promise)" CASE 122 FullWord$ = "Abet" Meaning$ = "Encourage, assist" CASE 123 FullWord$ = "Abject" Meaning$ = "Miserable, degrade" CASE 124 FullWord$ = "Abreast" Meaning$ = "Side by side and facing the same way" CASE 125 FullWord$ = "Absence" Meaning$ = "Person not present" CASE 126 FullWord$ = "Absorb" Meaning$ = "Incorporate, take in" CASE 127 FullWord$ = "Abstain" Meaning$ = "Refrain, decline to vote" CASE 128 FullWord$ = "Accent" Meaning$ = "Style of pronounciation of region or social group" CASE 129 FullWord$ = "Accost" Meaning$ = "Approach or speak boldly" CASE 130 FullWord$ = "Acerbic" Meaning$ = "Harsh and sharp" CASE 131 FullWord$ = "Achieve" Meaning$ = "Reach or attain by effort, acomplish" CASE 132 FullWord$ = "Acme" Meaning$ = "Highest point" CASE 133 FullWord$ = "Addict" Meaning$ = "Devotee, dependent" CASE 134 FullWord$ = "Adjudge" Meaning$ = "Pronounce judgement on" CASE 135 FullWord$ = "Admit" Meaning$ = "Acknowledge, recognise as true" CASE 136 FullWord$ = "Adroit" Meaning$ = "Dexterous, skilfull" CASE 137 FullWord$ = "Advance" Meaning$ = "Move or put forward, progress" CASE 138 FullWord$ = "Adze" Meaning$ = "Axe with arched blade at right angles to handle" CASE 139 FullWord$ = "Advocaat" Meaning$ = "Liqueur of eggs, sugar and brandy" CASE 140 FullWord$ = "Aerofoil" Meaning$ = "Structure with curve surface, designed to give lift in flight" CASE 141 FullWord$ = "Afresh" Meaning$ = "Anew, start again" CASE 142 FullWord$ = "Afford" Meaning$ = "Have enough money" CASE 143 FullWord$ = "Agent" Meaning$ = "Person acting for another in business" CASE 144 FullWord$ = "Agile" Meaning$ = "Quick moving, nimble" CASE 145 FullWord$ = "Affix" Meaning$ = "Attach, fasten" CASE 146 FullWord$ = "Ahoy" Meaning$ = "Call used in hailing" CASE 147 FullWord$ = "Albumen" Meaning$ = "Egg white" CASE 148 FullWord$ = "Alfresco" Meaning$ = "In the open air" CASE 149 FullWord$ = "Almond" Meaning$ = "Kernel of nutlike fruit related to plum" CASE 150 FullWord$ = "Altitude" Meaning$ = "Height of object above sea level or horizon" CASE 151 FullWord$ = "Ancestor" Meaning$ = "Person, animal or plant from which another has decended or evolved" CASE 152 FullWord$ = "Antacid" Meaning$ = "Preventive or corrective of acidity" CASE 153 FullWord$ = "Antelope" Meaning$ = "Swift deerlike animal" CASE 154 FullWord$ = "Antiquity" Meaning$ = "Ancient times, great age, remains of an ancient time" CASE 156 FullWord$ = "Apiary" Meaning$ = "Place where bees are kept" CASE 157 FullWord$ = "Applaud" Meaning$ = "Express approval by clapping" CASE 158 FullWord$ = "Arcane" Meaning$ = "Mysterious, secret" CASE 159 FullWord$ = "Arsenal" Meaning$ = "Place where weapons and ammunition are made and stored" CASE 160 FullWord$ = "Ashamed" Meaning$ = "Embarrased by shame" CASE 161 FullWord$ = "Aspire" Meaning$ = "Have ambition or strong desire" CASE 162 FullWord$ = "Atelier" Meaning$ = "Workshop, artist's studio" CASE 163 FullWord$ = "Attack" Meaning$ = "Try to hurt or deflect using force" CASE 164 FullWord$ = "Audit" Meaning$ = "Official scrutiny of accounts" CASE 165 FullWord$ = "Austral" Meaning$ = "Southern" CASE 166 FullWord$ = "Avail" Meaning$ = "Be of use or help" CASE 167 FullWord$ = "Avid" Meaning$ = "Eager, greedy" CASE 168 FullWord$ = "Awe" Meaning$ = "Reverential fear or wonder" CASE 169 FullWord$ = "Aye" Meaning$ = "Affirmative answer or vote" CASE 170 FullWord$ = "Axe" Meaning$ = "Chopping tool with heavy blade" CASE 171 FullWord$ = "Azure" Meaning$ = "Blue sky" CASE 172 FullWord$ = "Badge" Meaning$ = "Small flat emblem worn as sign of office or membership" CASE 173 FullWord$ = "Bachelor" Meaning$ = "Unmarried man, person with a university degree" CASE 174 FullWord$ = "Bacterium" Meaning$ = "Single celled micro-organism" CASE 175 FullWord$ = "Baffle" Meaning$ = "Perplex, frustrate" CASE 176 FullWord$ = "Bagel" Meaning$ = "Ring-shaped bread roll" CASE 177 FullWord$ = "Banister" Meaning$ = "Upright and handrail beside staircase" CASE 178 FullWord$ = "Bankrupt" Meaning$ = "Insolvent, drained of emotion" CASE 179 FullWord$ = "Baritone" Meaning$ = "Adult male singing voice between tenor and bass" CASE 180 FullWord$ = "Barnacle" Meaning$ = "Small shellfish clinging to rocks or ships' bottoms" CASE 181 FullWord$ = "Basal" Meaning$ = "Forming base" CASE 182 FullWord$ = "Batiste" Meaning$ = "Fine cotton or linen" CASE 183 FullWord$ = "Bauble" Meaning$ = "Showy trinket" CASE 184 FullWord$ = "Batwing" Meaning$ = "Shaped like a bat's wing" CASE 185 FullWord$ = "Bawdy" Meaning$ = "Humorously indecent" CASE 186 FullWord$ = "Beady" Meaning$ = "Small and bright" CASE 187 FullWord$ = "Beano" Meaning$ = "Party, celebration" CASE 188 FullWord$ = "Becalm" Meaning$ = "Ship(..etc) deprived of wind" CASE 189 FullWord$ = "Bedlam" Meaning$ = "Scene of confusion or uproar" CASE 190 FullWord$ = "Beduab" Meaning$ = "Smear with paint...etc" CASE 191 FullWord$ = "Bedeck" Meaning$ = "Adorn, decorate" CASE 192 FullWord$ = "Befog" Meaning$ = "Obscure, envelop in fog" CASE 193 FullWord$ = "Belfry" Meaning$ = "Bell tower, space for bells in church tower" CASE 194 FullWord$ = "Beryllium" Meaning$ = "Hard white metalic element" CASE 195 FullWord$ = "Besmirch" Meaning$ = "Soil, dishonour" CASE 196 FullWord$ = "Besotted" Meaning$ = "Infatuated, stupefied" CASE 197 FullWord$ = "Bevy" Meaning$ = "Company, flock" CASE 198 FullWord$ = "Bewail" Meaning$ = "Mourn for" CASE 199 FullWord$ = "Bicker" Meaning$ = "Quarrel, wrangle pettily" CASE 200 FullWord$ = "betroth" Meaning$ = "Bind with promise to marry" CASE 201 FullWord$ = "bifurcate" Meaning$ = "Divide into two branches" CASE 202 FullWord$ = "bistre" Meaning$ = "Brown pigment made from soot" CASE 203 FullWord$ = "bistro" Meaning$ = "Small informal restaurant" CASE 204 FullWord$ = "bizarre" Meaning$ = "Strange in appearance or effect" CASE 205 FullWord$ = "Blimey" Meaning$ = "Expressing surprise" CASE 206 FullWord$ = "blithe" Meaning$ = "Happy, carefree, casual" CASE 207 FullWord$ = "blowzy" Meaning$ = "Coarse-looking, red faced" CASE 208 FullWord$ = "Bondsman" Meaning$ = "Slave, serf" CASE 209 FullWord$ = "bookish" Meaning$ = "Fond of reading" CASE 210 FullWord$ = "bowel" Meaning$ = "Intestine" CASE 211 FullWord$ = "Bower" Meaning$ = "Summer house" END SELECT END SUB SUB DialogBox (DialogType, Message$, Confirm) CALL MousePointer(MOff) 'Turn mouse pointer off CloseDialog = False REDIM PrevScreen(8120) GET (185, 120)-(455, 225), PrevScreen 'Draw the box LINE (185, 120)-(455, 225), 7, BF 'Draw highlight and shadow LINE (185, 120)-(455, 120), 15 LINE (185, 120)-(185, 225), 15 LINE (185, 225)-(455, 225), 8 LINE (455, 120)-(455, 225), 8 'Draw window's title bar LINE (188, 123)-(452, 135), 1, BF LINE (188, 123)-(452, 123), 8 LINE (188, 123)-(188, 135), 8 LINE (188, 135)-(452, 135), 15 LINE (452, 123)-(452, 135), 15 COLOR 8: LOCATE 12, 35 + 1: PRINT Message$ 'Display the message SELECT CASE DialogType CASE YesNo PLAY "T240 MN L16 O3 A" 'Draw a "?" icon COLOR 2 'Color of the circle CIRCLE (233, 165), 24 'Draw the border PAINT (233, 165), 2 'Fill in the circle COLOR 8 CIRCLE (233, 165), 25 'Draw the border COLOR 15 CIRCLE (233, 160), 15 CIRCLE (233, 160), 8 PAINT (233, 160), 2 LINE (212, 160)-(233, 173), 2, BF LINE (218, 160)-(225, 160), 15 LINE (230, 164)-(236, 174), 15, BF LINE (230, 164)-(240, 166), 15, BF PAINT (233, 150), 15 CIRCLE (233, 178), 3 PAINT (233, 178) COLOR 2: PSET (230, 164) 'Draw the Yes and No buttons LINE (215, 192)-(315, 192), 15 LINE (215, 192)-(215, 215), 15 LINE (215, 215)-(315, 215), 8 LINE (315, 192)-(315, 215), 8 LINE (325, 192)-(425, 192), 15 LINE (325, 192)-(325, 215), 15 LINE (325, 215)-(425, 215), 8 LINE (425, 192)-(425, 215), 8 COLOR 8 LOCATE 15, 32: PRINT "Yes" LOCATE 15, 47: PRINT "No" CALL MousePointer(MOn) 'Turn mouse pointer on CALL MousePointer(MCoordinates) 'Get coordinates DO CALL mouse(cx, dx, bx) 'Filter a 1 for Left IF bx = 1 THEN PY1 = 192 PY2 = 215 IF dx > 215 AND dx < 315 AND cx > 192 AND cx < 215 THEN Confirm = Yes PX1 = 215 PX2 = 315 CALL MousePointer(MOff) 'Turn mouse pointer off CALL ButtonPress(PX1, PX2, PY1, PY2) CloseDialog = True END IF IF dx > 325 AND dx < 425 AND cx > 192 AND cx < 215 THEN Confirm = No PX1 = 325 PX2 = 425 CALL MousePointer(MOff) 'Turn mouse pointer off CALL ButtonPress(PX1, PX2, PY1, PY2) CloseDialog = True END IF END IF LOOP UNTIL CloseDialog = True CASE Okay 'Draw a "!" icon COLOR 14 'Color of the circle CIRCLE (233, 165), 24 'Draw the border PAINT (233, 165), 14 'Fill in the circle COLOR 8 CIRCLE (233, 165), 25 'Draw the "!" FOR s = 1 TO 11 LINE (233, 170)-(233 - 6 + s, 155), 8 NEXT s CIRCLE (233, 155), 5 PAINT (233, 154), 8 CIRCLE (233, 176), 3 PAINT (233, 176) 'Draw OK button LINE (270, 192)-(370, 192), 15 LINE (270, 192)-(270, 215), 15 LINE (270, 215)-(370, 215), 8 LINE (370, 192)-(370, 215), 8 COLOR 8: LOCATE 15, 40: PRINT "OK" CALL MousePointer(MOn) 'turn mouse pointer on CALL MousePointer(MCoordinates) 'Get coordinates DO CALL mouse(cx, dx, bx) 'Filter a 1 for Left IF bx = 1 AND cx > 192 AND cx < 215 AND dx > 270 AND dx < 370 THEN PY1 = 192 PY2 = 215 PX1 = 270 PX2 = 370 CALL ButtonPress(PX1, PX2, PY1, PY2) CloseDialog = True END IF LOOP UNTIL CloseDialog = True CASE Notice 'Draw a blue "!" icon COLOR 1 'Color of the circle CIRCLE (233, 165), 24 'Draw the border PAINT (233, 165), 1 'Fill in the circle LINE (230, 152)-(236, 170), 15, BF LINE (230, 174)-(236, 178), 15, BF CALL MousePointer(MOn) 'Turn mouse pointer on CALL MousePointer(MCoordinates) 'Get coordinates SLEEP 2 END SELECT PUT (185, 120), PrevScreen, PSET END SUB SUB DrawTitle '---------------------------------------------------------------------------- 'Draw the title '---------------------------------------------------------------------------- LINE (5, 2)-(635, 30), 1, BF 'Draw a blue box COLOR 8 'Set color to grey LINE (5, 2)-(635, 2) 'Draw shadow line LINE (5, 2)-(5, 30) 'Draw shadow line COLOR 15 'Set color to bright white LINE (5, 30)-(635, 30) 'Draw light line LINE (635, 2)-(635, 30) 'Draw light line ' The Hangman title COLOR 14 Center = (640 - 116) / 2 'Center the title 'HANGMAN title using my own "font" LINE (15 + Center, 10)-(15 + Center, 20) '} LINE (16 + Center, 10)-(16 + Center, 20) '} LINE (15 + Center, 15)-(25 + Center, 15) '} LINE (15 + Center, 16)-(25 + Center, 16) '} Letter H LINE (25 + Center, 10)-(25 + Center, 20) '} LINE (26 + Center, 10)-(26 + Center, 20) '} LINE (35 + Center, 10)-(30 + Center, 20) '} LINE (36 + Center, 10)-(31 + Center, 20) '} LINE (32 + Center, 18)-(38 + Center, 18) '} Letter A LINE (32 + Center, 17)-(38 + Center, 17) '} LINE (35 + Center, 10)-(40 + Center, 20) '} LINE (36 + Center, 10)-(41 + Center, 20) '} LINE (45 + Center, 10)-(45 + Center, 20) '} LINE (46 + Center, 10)-(46 + Center, 20) '} LINE (45 + Center, 10)-(55 + Center, 20) '} Letter N LINE (46 + Center, 10)-(56 + Center, 20) '} LINE (55 + Center, 10)-(55 + Center, 20) '} LINE (56 + Center, 10)-(56 + Center, 20) '} LINE (64 + Center, 10)-(70 + Center, 10) '} LINE (64 + Center, 11)-(70 + Center, 11) '} LINE (60 + Center, 12)-(61 + Center, 11) '} LINE (62 + Center, 12)-(63 + Center, 11) '} LINE (60 + Center, 12)-(63 + Center, 10) '} LINE (61 + Center, 12)-(64 + Center, 10) '} LINE (60 + Center, 12)-(60 + Center, 17) '} LINE (61 + Center, 12)-(61 + Center, 17) '} LINE (60 + Center, 17)-(61 + Center, 18) '} Letter G LINE (61 + Center, 17)-(62 + Center, 18) '} LINE (60 + Center, 18)-(63 + Center, 20) '} LINE (61 + Center, 18)-(64 + Center, 20) '} LINE (63 + Center, 19)-(70 + Center, 19) '} LINE (64 + Center, 20)-(71 + Center, 20) '} LINE (67 + Center, 15)-(70 + Center, 15) '} LINE (67 + Center, 16)-(70 + Center, 16) '} LINE (70 + Center, 15)-(70 + Center, 20) '} PSET (71 + Center, 20) '} LINE (75 + Center, 10)-(75 + Center, 20) '} LINE (76 + Center, 10)-(76 + Center, 20) '} LINE (75 + Center, 10)-(80 + Center, 15) '} LINE (76 + Center, 10)-(81 + Center, 15) '} Letter M LINE (80 + Center, 15)-(85 + Center, 10) '} LINE (81 + Center, 15)-(86 + Center, 10) '} LINE (85 + Center, 10)-(85 + Center, 20) '} LINE (86 + Center, 10)-(86 + Center, 20) '} LINE (95 + Center, 10)-(90 + Center, 20) '} LINE (96 + Center, 10)-(91 + Center, 20) '} LINE (92 + Center, 18)-(98 + Center, 18) '} Letter A LINE (92 + Center, 17)-(98 + Center, 17) '} LINE (95 + Center, 10)-(100 + Center, 20) '} LINE (96 + Center, 10)-(101 + Center, 20) '} LINE (105 + Center, 10)-(105 + Center, 20) '} LINE (106 + Center, 10)-(106 + Center, 20) '} LINE (105 + Center, 10)-(115 + Center, 20) '} Letter N LINE (106 + Center, 10)-(116 + Center, 20) '} LINE (115 + Center, 10)-(115 + Center, 20) '} LINE (116 + Center, 10)-(116 + Center, 20) '} END SUB SUB Intro PAINT (320, 175), 3 'Repaint the screen to cyan COLOR 15, 7 'Draw the dialog box FOR x = 0 TO 160 LINE ((320 - x + 1), 101)-((320 + x - 1), 244), 7, BF LINE ((320 - x), 100)-((320 + x), 100), 15 LINE ((320 - x), 100)-((320 - x), 245), 15 LINE ((320 - x), 245)-((320 + x), 245), 8 LINE ((320 + x), 100)-((320 + x), 245), 8 NEXT x 'Draw progress bar outer border LINE (170, 110)-(220, 110), 15 LINE (170, 110)-(170, 235), 15 LINE (170, 235)-(220, 235), 8 LINE (220, 110)-(220, 235), 8 'Draw progress bar inner panel LINE (184, 119)-(206, 119), 8 LINE (184, 119)-(184, 201), 8 LINE (184, 201)-(206, 201), 15 LINE (206, 119)-(206, 201), 15 'Draw a diskette LINE (180, 208)-(210, 230), 1, BF 'The blue diskette LINE (210, 208)-(210, 230), 8, BF 'Right shadow LINE (180, 230)-(210, 230), 8, BF 'Buttom shadow LINE (184, 221)-(206, 221), 8, BF 'Shadow on the diskette LINE (184, 221)-(184, 230), 8, BF 'Shadow on the diskette LINE (188, 208)-(200, 208), 7 LINE (188, 209)-(200, 216), 15, BF 'The metal protector LINE (197, 210)-(199, 215), 1, BF 'The metal protector LINE (180, 208)-(180, 208), 7 'Rounded edge LINE (210, 208)-(210, 208), 7 'Rounded edge 'Draw border for wordings LINE (230, 110)-(470, 110), 8 LINE (230, 110)-(230, 210), 8 LINE (230, 210)-(470, 210), 15 LINE (470, 110)-(470, 210), 15 COLOR 8 LOCATE 10, 31: PRINT "QuickBASIC Hangman" LOCATE 11, 31: PRINT "(211 guess words)" LOCATE 12, 31: PRINT "English version" LOCATE 14, 31: PRINT "Written by Lim Chang Meng" LOCATE 17, 31: PRINT "Loading Hangman" SLEEP 1 'The progress bar FOR Progress = 1 TO 80 LINE (185, (200 - Progress))-(205, (200 - Progress)), 4, BF FOR SlightDelay = 1 TO 10000 NEXT SlightDelay NEXT Progress SLEEP 1 FOR B = 0 TO 350 LINE (0, B)-(29, B), 7 IF B > 88 AND B < 340 THEN LINE (30, B)-(280, B), 3 LINE (30, B)-(30, B), 8 LINE (280, B)-(280, B), 15 ELSE LINE (30, B)-(280, B), 7 END IF LINE (281, B)-(639, B), 7 IF B = 88 THEN LINE (30, 88)-(280, 88), 8 IF B = 340 THEN LINE (30, 340)-(280, 340), 15 FOR SlightDelay = 1 TO 3000 NEXT SlightDelay NEXT B END SUB SUB mouse (cx, dx, bx) POKE VARPTR(A(4)), &H92 'Swap code,Get CX setup CALL absolute(cx, VARPTR(A(0))) 'Run Code cx = cx 'Get Y coordinates POKE VARPTR(A(4)), &H91 'Swap code,Get DX setup CALL absolute(dx, VARPTR(A(0))) 'Run Code dx = dx 'Get X coordinates POKE VARPTR(A(4)), &H93 'Swap code,Get BX setup CALL absolute(bx, VARPTR(A(0))) 'Run Code 'Note : 'Add the /8 to cx or dx for text modes END SUB SUB MousePointer (SW) POKE VARPTR(A(0)) + 1, SW 'Swap code,Set AX = (SW) CALL absolute(c, VARPTR(A(0))) 'Run Code 'Note: 'SW = 0-reset 'SW = 1-on 'SW = 2-off 'SW = 3-coordinates END SUB SUB SetupScreen LINE (0, 0)-(640, 350), 7, BF '---------------------------------------------------------------------------- 'The Hangman picture box '---------------------------------------------------------------------------- ' Draw a cyan box LINE (30, 88)-(280, 340), 3, BF ' Put black line on top and left line for light effect COLOR 8: LINE (30, 88)-(280, 88): LINE (30, 88)-(30, 340) ' Put bright-white line on buttom and right line for shadow effect COLOR 15: LINE (280, 88)-(280, 340): LINE (30, 340)-(280, 340) ' The above will give a "sunken" blue box effect '---------------------------------------------------------------------------- 'Draw the alphabet buttons '---------------------------------------------------------------------------- alphabets$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ' Draw a border for alphabet buttons LINE (300, 105)-(608, 105), 8 LINE (300, 105)-(300, 285), 8 LINE (300, 285)-(608, 285), 8 LINE (608, 105)-(608, 285), 8 LINE (301, 106)-(607, 106), 15 LINE (301, 106)-(301, 284), 15 LINE (301, 286)-(609, 286), 15 LINE (609, 106)-(609, 286), 15 ' Draw the buttons FOR Choose = 1 TO 26 GotIt$ = UCASE$(MID$(alphabets$, Choose, 1)) SELECT CASE Choose CASE 1 ' First row PosX = 37 PosY = 10 x1 = 275 y1 = 120 x2 = 310 y2 = 145 CASE 8 ' Second row PosX = 37 PosY = 13 x1 = 275 y1 = 120 + 42 x2 = 310 y2 = 145 + 42 CASE 15 ' Third row PosX = 37 PosY = 16 x1 = 275 y1 = 120 + (42 * 2) x2 = 310 y2 = 145 + (42 * 2) CASE 22 ' Fourth row PosX = 37 PosY = 19 x1 = 275 y1 = 120 + (42 * 3) x2 = 310 y2 = 145 + (42 * 3) END SELECT ' Setup the horizontal spacing for the buttons PosX = PosX + 5 x1 = x1 + 40 x2 = x2 + 40 ' Place the alphabets on the appropriate locations COLOR 8: LOCATE PosY, PosX: PRINT GotIt$; ' Draw black lines on the buttom and right LINE (x2, y1)-(x2, y2), 8 LINE (x1, y2)-(x2, y2), 8 ' Draw bright-white lines on the top and left LINE (x1, y1)-(x2, y1), 15 LINE (x1, y1)-(x1, y2), 15 ' The above lines will give a "floated" 3D button effect NEXT Choose '---------------------------------------------------------------------------- 'Guess word '---------------------------------------------------------------------------- LOCATE 4, 3: PRINT "Guess this : " '---------------------------------------------------------------------------- 'Draw the help box '---------------------------------------------------------------------------- 'Draw a 3D border for the hint box LINE (300, 35)-(608, 60), 8, B LINE (301, 36)-(607, 59), 15, B '---------------------------------------------------------------------------- 'Draw game status panel '---------------------------------------------------------------------------- 'Draw a 3D panel for game status LINE (300, 63)-(608, 102), 2, BF LINE (300, 63)-(608, 63), 8 LINE (300, 63)-(300, 102), 8 LINE (300, 102)-(608, 102), 15 LINE (608, 63)-(608, 102), 15 LINE (304, 66)-(604, 99), 7, BF LINE (304, 66)-(604, 66), 15 LINE (304, 66)-(304, 99), 15 LINE (304, 99)-(604, 99), 8 LINE (604, 66)-(604, 99), 8 '---------------------------------------------------------------------------- 'Draw control buttons '---------------------------------------------------------------------------- COLOR 8 LOCATE 23, 40: PRINT " New" LOCATE 23, 53: PRINT " Hint" LOCATE 23, 66: PRINT " Exit" ' Set the initial coordinated x1 = 300 y1 = 300 x2 = 400 y2 = 330 ' Draw the control buttons FOR Button = 1 TO 3 LINE (x1, y1)-(x2, y1), 15 LINE (x1, y1)-(x1, y2), 15 LINE (x1, y2)-(x2, y2), 8 LINE (x2, y1)-(x2, y2), 8 x1 = x1 + 105 x2 = x2 + 105 NEXT Button '--------------------------------------------------------------------------- 'Draw icons for the control buttons '--------------------------------------------------------------------------- 'The "New" button - give it a diskette xb = 138 yb = 96 LINE (180 + xb, 208 + yb)-(210 + xb, 230 + yb), 1, BF 'The blue diskette LINE (210 + xb, 208 + yb)-(210 + xb, 230 + yb), 8, BF 'Right shadow LINE (180 + xb, 230 + yb)-(210 + xb, 230 + yb), 8, BF 'Buttom shadow LINE (184 + xb, 221 + yb)-(206 + xb, 221 + yb), 8, BF 'Shadow on the diskette LINE (184 + xb, 221 + yb)-(184 + xb, 230 + yb), 8, BF 'Shadow on the diskette LINE (188 + xb, 208 + yb)-(200 + xb, 208 + yb), 7 LINE (188 + xb, 209 + yb)-(200 + xb, 216 + yb), 15, BF 'The metal protector LINE (197 + xb, 210 + yb)-(199 + xb, 215 + yb), 1, BF 'The metal protector LINE (180 + xb, 208 + yb)-(180 + xb, 208 + yb), 7 'Rounded edge LINE (210 + xb, 208 + yb)-(210 + xb, 208 + yb), 7 'Rounded edge 'The "Hint" button - give it a lightbulb LINE (435, 305)-(435, 307), 14 'Draw lights shining out LINE (445, 315)-(447, 315), 14 LINE (423, 315)-(425, 315), 14 LINE (426, 308)-(429, 310), 14 LINE (442, 319)-(444, 320), 14 LINE (444, 308)-(442, 310), 14 LINE (429, 319)-(426, 320), 14 COLOR 8: CIRCLE (435, 315), 6 'Draw a border COLOR 14: CIRCLE (435, 315), 5 'Draw a circle PAINT (435, 315), 14 'Fill in the circle LINE (433, 318)-(437, 321), 14, BF LINE (432, 319)-(433, 321), 6 LINE (438, 319)-(437, 321), 6 LINE (433, 322)-(437, 323), 6, BF LINE (435, 324)-(435, 324), 8, BF 'The "Exit" button - give it an "X" COLOR 12: CIRCLE (540, 315), 12 'Draw a circle PAINT (540, 315), 12 'Fill in the circle COLOR 8: CIRCLE (540, 315), 13 'Draw a border FOR A = 1 TO 3 LINE (533 + A, 310)-(543 + A, 320), 15 LINE (543 + A, 310)-(533 + A, 320), 15 NEXT A END SUB