The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 
 


  << Previous Topic | Next Topic >>Return to Index  

solitaire.bas no tested

May 11 2012 at 9:26 AM
Anonymous  (no login)

 
REM **********************************************
REM More Qbasic Software at
REM http://www.euronet.nl/users/rkohm/
REM Any Questions? E-mail to:
REM rkohm@euronet.nl
REM **********************************************

DECLARE SUB doyouwin ()
DECLARE SUB printt (text$, lin!)
DECLARE SUB check (first!, second!)
DECLARE SUB fieldsetup ()
DECLARE SUB move (whereto!)
DECLARE SUB game ()
DECLARE SUB background ()

COMMON SHARED loca, x, y, result, result1, result2, ok, gone
DIM SHARED place(33)
CONST YES = 1, NO = 0

CLS : SCREEN 12
ON KEY(10) GOSUB endofgame
KEY(10) ON
loca = 1
PALETTE 13, 35 + 35 * 256 + 35 * 65536

background
fieldsetup

'FOR u = 1 TO 33
' SELECT CASE u
' CASE 5, 10: place(u) = 1
' CASE ELSE: place(u) = 0
' END SELECT
'NEXT
'fieldsetup

again2:
DO
result = 0: result1 = 0: result2 = 0
printt "", 0: printt "Select a pin.", 1
game
printt "", 0
IF result <> 0 AND place(result) = 0 THEN
printt "You have to select a pin, that's a red circle.", 1
printt "Press any key to continue..", 2: PLAY "l64c"
DO: LOOP UNTIL INKEY$ <> "": GOTO again2
END IF
result1 = result
move loca
DRAW "c2h2f4h2g2e4"
again3:
printt "", 0: printt "Select an empty place to move the pin to.", 1
result = 0
game
IF result <> 0 AND place(result) = 1 THEN
printt "You have to select an empty (white) place to move the selected pin", 1
printt "to. You selected a pin. Press any key to continue..", 2: PLAY "l64c"
DO: LOOP UNTIL INKEY$ <> "": GOTO again3
END IF
IF result = 0 THEN GOTO again2
result2 = result
check result1, result2
IF ok = YES AND place(gone) <> 0 THEN
place(result1) = 0: place(gone) = 0: place(result2) = 1
move result1: CIRCLE (x, y), 5, 4: PAINT (x, y), 4, 4: CIRCLE (x, y), 5, 15: PAINT (x, y), 15, 15
move result2: CIRCLE (x, y), 5, 4: PAINT (x, y), 4, 4
move gone: CIRCLE (x, y), 5, 4: PAINT (x, y), 4, 4: CIRCLE (x, y), 5, 15: PAINT (x, y), 15, 15
ELSE
printt "", 0
printt "Wrong choice. The red pin can't jump to this empty place.", 1
printt "Press any key to continue...", 2: PLAY "l64c"
DO: LOOP UNTIL INKEY$ <> ""
move result1
t$ = "bm" + STR$(x) + "," + STR$(y) + "c4h2f4h2g2e4"
DRAW "X" + VARPTR$(t$)
END IF
doyouwin
LOOP

END

endofgame:
END

SUB background
DRAW "c15bf100u200l200d200r200bf10u220l220d220r220bhp15,15"
DRAW "bm295,315 p13,15c15u50l50u50r50u50r50d50r50d50l50d50l50u150r25d150"
DRAW "r25u100r50l150d25r150d25l125u50be25r50bf25d50bg25l50"

DRAW "bm120,28c15r400d55l400u55bm40,363r560d40l560u40bm250,430r107d20l107u20"
DRAW "bm1,1p8,15"
DRAW "bm120,28c4r400d55l400u55bm40,363r560d40l560u40bm250,430r107d20l107u20"
COLOR 1: LOCATE 28, 33: PRINT "By Robin Ohm"
LOCATE 3, 17: COLOR 14: PRINT "F10"; : COLOR 15: PRINT " Exit"
LOCATE 4, 17: COLOR 14: PRINT "(Arrow keys on the Number Pad)"; : COLOR 15: PRINT " Move blue circle."
LOCATE 5, 17: COLOR 14: PRINT "Enter + Number "; : COLOR 15: PRINT "Select something."


FOR e = 1 TO 33
place(e) = 1
NEXT
place(17) = 0
END SUB

SUB check (first, second)
ok = NO: gone = 0
SELECT CASE first
CASE 1
IF second = 3 THEN ok = YES: gone = 2
IF second = 9 THEN ok = YES: gone = 4
CASE 2
IF second = 10 THEN ok = YES: gone = 5
CASE 3
IF second = 1 THEN ok = YES: gone = 2
IF second = 11 THEN ok = YES: gone = 6
CASE 4
IF second = 6 THEN ok = YES: gone = 5
IF second = 16 THEN ok = YES: gone = 9
CASE 5
IF second = 17 THEN ok = YES: gone = 10
CASE 6
IF second = 4 THEN ok = YES: gone = 5
IF second = 18 THEN ok = YES: gone = 11
CASE 7
IF second = 9 THEN ok = YES: gone = 8
IF second = 21 THEN ok = YES: gone = 14
CASE 8
IF second = 10 THEN ok = YES: gone = 9
IF second = 22 THEN ok = YES: gone = 15
CASE 9
IF second = 11 THEN ok = YES: gone = 10
IF second = 7 THEN ok = YES: gone = 8
IF second = 1 THEN ok = YES: gone = 4
IF second = 23 THEN ok = YES: gone = 16
CASE 10
IF second = 2 THEN ok = YES: gone = 5
IF second = 8 THEN ok = YES: gone = 9
IF second = 12 THEN ok = YES: gone = 11
IF second = 24 THEN ok = YES: gone = 17
CASE 11
IF second = 3 THEN ok = YES: gone = 6
IF second = 9 THEN ok = YES: gone = 10
IF second = 13 THEN ok = YES: gone = 12
IF second = 25 THEN ok = YES: gone = 18
CASE 12
IF second = 10 THEN ok = YES: gone = 11
IF second = 26 THEN ok = YES: gone = 19
CASE 13
IF second = 27 THEN ok = YES: gone = 20
IF second = 11 THEN ok = YES: gone = 12
CASE 14
IF second = 16 THEN ok = YES: gone = 15
CASE 15
IF second = 17 THEN ok = YES: gone = 16
CASE 16
IF second = 4 THEN ok = YES: gone = 9
IF second = 14 THEN ok = YES: gone = 15
IF second = 18 THEN ok = YES: gone = 17
IF second = 28 THEN ok = YES: gone = 23
CASE 17
IF second = 15 THEN ok = YES: gone = 16
IF second = 19 THEN ok = YES: gone = 18
IF second = 5 THEN ok = YES: gone = 10
IF second = 29 THEN ok = YES: gone = 24
CASE 18
IF second = 16 THEN ok = YES: gone = 17
IF second = 20 THEN ok = YES: gone = 19
IF second = 6 THEN ok = YES: gone = 11
IF second = 30 THEN ok = YES: gone = 25
CASE 19
IF second = 17 THEN ok = YES: gone = 18
CASE 20
IF second = 18 THEN ok = YES: gone = 19
CASE 21
IF second = 23 THEN ok = YES: gone = 22
IF second = 7 THEN ok = YES: gone = 14
CASE 22
IF second = 8 THEN ok = YES: gone = 15
IF second = 24 THEN ok = YES: gone = 23
CASE 23
IF second = 9 THEN ok = YES: gone = 16
IF second = 21 THEN ok = YES: gone = 22
IF second = 25 THEN ok = YES: gone = 24
IF second = 31 THEN ok = YES: gone = 28
CASE 24
IF second = 10 THEN ok = YES: gone = 17
IF second = 22 THEN ok = YES: gone = 23
IF second = 26 THEN ok = YES: gone = 25
IF second = 32 THEN ok = YES: gone = 29
CASE 25
IF second = 11 THEN ok = YES: gone = 18
IF second = 23 THEN ok = YES: gone = 24
IF second = 27 THEN ok = YES: gone = 25
IF second = 33 THEN ok = YES: gone = 29
CASE 26
IF second = 24 THEN ok = YES: gone = 25
IF second = 12 THEN ok = YES: gone = 19
CASE 27
IF second = 25 THEN ok = YES: gone = 26
IF second = 13 THEN ok = YES: gone = 20
CASE 28
IF second = 30 THEN ok = YES: gone = 29
IF second = 16 THEN ok = YES: gone = 23
CASE 29
IF second = 17 THEN ok = YES: gone = 24
CASE 30
IF second = 18 THEN ok = YES: gone = 25
IF second = 28 THEN ok = YES: gone = 29
CASE 31
IF second = 33 THEN ok = YES: gone = 32
IF second = 23 THEN ok = YES: gone = 28
CASE 32
IF second = 24 THEN ok = YES: gone = 29
CASE 33
IF second = 31 THEN ok = YES: gone = 32
IF second = 25 THEN ok = YES: gone = 30
END SELECT
END SUB

SUB doyouwin
FOR y = 1 TO 33
SELECT CASE y
CASE 17
IF place(y) = 1 THEN win = win + 1
CASE ELSE
IF place(y) = 0 THEN win = win + 1
END SELECT
IF win = 33 THEN
printt "", 0
printt "Congratulations!!! You have completed the puzzle!!!", 1
END
END IF
NEXT
END SUB

SUB fieldsetup
FOR r = 1 TO 33
move r
CIRCLE (x, y), 5, 13: PAINT (x, y), 13, 13
SELECT CASE place(r)
CASE 1: CIRCLE (x, y), 5, 4: PAINT (x, y), 4, 4
CASE 0: CIRCLE (x, y), 5, 4: PAINT (x, y), 4, 4
CIRCLE (x, y), 5, 15: PAINT (x, y), 15, 15
END SELECT
NEXT
END SUB

SUB game
again:
move loca
CIRCLE (x, y), 6, 1
DO: user$ = INKEY$: LOOP UNTIL user$ <> ""
CIRCLE (x, y), 6, 13
SELECT CASE user$
CASE "8"
SELECT CASE loca
CASE 4 TO 6, 31 TO 33: loca = loca - 3
CASE 14 TO 27: loca = loca - 7
CASE 28 TO 30, 9 TO 11: loca = loca - 5
CASE ELSE: PLAY "l64a": GOTO again
END SELECT
CASE "4"
SELECT CASE loca
CASE 1, 4, 7, 14, 21, 28, 31: PLAY "l64a": GOTO again
CASE ELSE: loca = loca - 1
END SELECT
CASE "6"
SELECT CASE loca
CASE 3, 6, 13, 20, 27, 30, 33: PLAY "l64a": GOTO again
CASE ELSE: loca = loca + 1
END SELECT
CASE "2"
SELECT CASE loca
CASE 1 TO 3, 28 TO 30: loca = loca + 3
CASE 4 TO 6, 23 TO 25: loca = loca + 5
CASE 7 TO 20: loca = loca + 7
CASE ELSE: PLAY "l64a": GOTO again
END SELECT
CASE CHR$(13)
IF loca = result1 THEN
move loca
DRAW "c4h2f4h2g2e4"
result1 = 0: result2 = 0: gone = 0
EXIT SUB
END IF
result = loca: PLAY "l64a": EXIT SUB
CASE ELSE
PLAY "l64a": GOTO again
END SELECT
move loca
CIRCLE (x, y), 6, 1
GOTO again
END SUB

SUB move (whereto)
SELECT CASE whereto
CASE 1: x = 295: y = 165
CASE 2: x = 320: y = 165
CASE 3: x = 345: y = 165
CASE 4: x = 295: y = 190
CASE 5: x = 320: y = 190
CASE 6: x = 345: y = 190
CASE 7: x = 245: y = 215
CASE 8: x = 270: y = 215
CASE 9: x = 295: y = 215
CASE 10: x = 320: y = 215
CASE 11: x = 345: y = 215
CASE 12: x = 370: y = 215
CASE 13: x = 395: y = 215
CASE 14: x = 245: y = 240
CASE 15: x = 270: y = 240
CASE 16: x = 295: y = 240
CASE 17: x = 320: y = 240
CASE 18: x = 345: y = 240
CASE 19: x = 370: y = 240
CASE 20: x = 395: y = 240
CASE 21: x = 245: y = 265
CASE 22: x = 270: y = 265
CASE 23: x = 295: y = 265
CASE 24: x = 320: y = 265
CASE 25: x = 345: y = 265
CASE 26: x = 370: y = 265
CASE 27: x = 395: y = 265
CASE 28: x = 295: y = 290
CASE 29: x = 320: y = 290
CASE 30: x = 345: y = 290
CASE 31: x = 295: y = 315
CASE 32: x = 320: y = 315
CASE 33: x = 345: y = 315
END SELECT
END SUB

SUB printt (text$, lin)
SELECT CASE lin
CASE 1: LOCATE 24, 7
CASE 2: LOCATE 25, 7
END SELECT
IF text$ = "" THEN
LOCATE 24, 7: PRINT SPACE$(68)
LOCATE 25, 7: PRINT SPACE$(68)
EXIT SUB
END IF
PRINT text$
END SUB


 
 Respond to this message   
AuthorReply
Anonymous
(no login)

this is a game and if you copy in compiler

May 12 2012, 5:23 AM 

and press f5 show the dandy some statements you put an apostrophe before
by were cursor wait and press again f5 up that works

 
 Respond to this message   
Ben
(no login)

Who are you?

May 13 2012, 8:30 AM 


 
 Respond to this message   
Current Topic - solitaire.bas no tested
  << Previous Topic | Next Topic >>Return to Index  
 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement  

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums