mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-08-31 17:00:15 +00:00
These tests use a variety of sample code (with some of the larger files removed, so they are not complete!) and verifies that they all compile successfully.
1580 lines
31 KiB
QBasic
1580 lines
31 KiB
QBasic
CHDIR ".\programs\samples\thebob\sol"
|
|
|
|
'****************************************************************************'
|
|
'-------------------------- S O L I T A I R E - 3 ---------------------------'
|
|
'------------- Copyright (C) 2000-2007 by Bob Seguin (Freeware) -------------'
|
|
'****************************************************************************'
|
|
|
|
DEFINT A-Z
|
|
|
|
DECLARE FUNCTION InitMOUSE ()
|
|
|
|
DECLARE SUB MouseDRIVER (LB, RB, mX, mY)
|
|
DECLARE SUB MouseSTATUS (LB, RB, MouseX, MouseY)
|
|
DECLARE SUB ShowMOUSE ()
|
|
DECLARE SUB HideMOUSE ()
|
|
DECLARE SUB PauseMOUSE (LB, RB, MouseX, MouseY)
|
|
DECLARE SUB ClearMOUSE ()
|
|
|
|
DECLARE SUB DrawSCREEN (Mode)
|
|
DECLARE SUB Interval (Length!)
|
|
DECLARE SUB CheckOUT ()
|
|
DECLARE SUB InitVALS ()
|
|
|
|
DECLARE SUB PlayGAME ()
|
|
|
|
DECLARE SUB Sol3MENU (Item)
|
|
DECLARE SUB Sol3DEAL ()
|
|
DECLARE SUB Sol3UNDO ()
|
|
DECLARE SUB Sol3HELP (Item)
|
|
DECLARE SUB BigBOX (InOUT)
|
|
|
|
DECLARE SUB SetSCORE ()
|
|
DECLARE SUB PutCARD (x, y, CardNUM)
|
|
DECLARE SUB CheckTOTAL ()
|
|
DECLARE SUB Finito ()
|
|
|
|
TYPE PlayTYPE
|
|
Suit AS INTEGER
|
|
Value AS INTEGER
|
|
x AS INTEGER
|
|
y AS INTEGER
|
|
UpDOWN AS INTEGER
|
|
END TYPE
|
|
DIM SHARED MainPLAY(1 TO 7, 0 TO 18) AS PlayTYPE
|
|
|
|
TYPE DeckTYPE
|
|
Suit AS INTEGER
|
|
Value AS INTEGER
|
|
END TYPE
|
|
DIM SHARED Decks(1 TO 3, 1 TO 8) AS DeckTYPE
|
|
DIM SHARED TurnUPs(0 TO 24) AS DeckTYPE
|
|
DIM SHARED Stacks(1 TO 4) AS DeckTYPE
|
|
DIM SHARED Trick(1 TO 18) AS DeckTYPE
|
|
|
|
DIM SHARED LettFileName$
|
|
|
|
REDIM SHARED Buttons(600)
|
|
REDIM SHARED Title(1 TO 250)
|
|
REDIM SHARED Card(1 TO 2400)
|
|
REDIM SHARED CardBACK(1 TO 2400)
|
|
REDIM SHARED BackERASE(1 TO 2600)
|
|
REDIM SHARED Selected(1 TO 2400)
|
|
REDIM SHARED Suits(1 TO 800)
|
|
REDIM SHARED MenuBOX(220)
|
|
REDIM SHARED ItemBOX(500)
|
|
REDIM SHARED MenuGFX(500)
|
|
REDIM SHARED Deck(1 TO 52)
|
|
REDIM SHARED TopOFF(1 TO 44)
|
|
REDIM SHARED Chek(50)
|
|
REDIM SHARED GetBOX(8000)
|
|
REDIM SHARED OtherBOX(8000)
|
|
REDIM SHARED Numbers(1100)
|
|
|
|
DIM SHARED Score AS LONG
|
|
DIM SHARED MoneyCARD
|
|
DIM SHARED Tally
|
|
DIM SHARED StackIT
|
|
DIM SHARED Completed
|
|
DIM SHARED MouseDATA$
|
|
|
|
DIM SHARED Vegas
|
|
DIM SHARED Money
|
|
OPEN "sol3opts.dat" FOR INPUT AS #1
|
|
INPUT #1, Vegas, Money
|
|
CLOSE #1
|
|
|
|
DEF SEG = VARSEG(Suits(1))
|
|
BLOAD "sol3suit.bsv", VARPTR(Suits(1))
|
|
DEF SEG = VARSEG(Buttons(0))
|
|
BLOAD "sol3btns.bsv", VARPTR(Buttons(0))
|
|
DEF SEG = VARSEG(Title(1))
|
|
BLOAD "sol3titl.bsv", VARPTR(Title(1))
|
|
DEF SEG = VARSEG(CardBACK(1))
|
|
BLOAD "sol3cd53.bsv", VARPTR(CardBACK(1))
|
|
DEF SEG = VARSEG(BackERASE(1))
|
|
BLOAD "sol3cd54.bsv", VARPTR(BackERASE(1))
|
|
DEF SEG = VARSEG(Selected(1))
|
|
BLOAD "sol3sele.bsv", VARPTR(Selected(1))
|
|
DEF SEG = VARSEG(TopOFF(1))
|
|
BLOAD "sol3topp.bsv", VARPTR(TopOFF(1))
|
|
DEF SEG = VARSEG(Chek(0))
|
|
BLOAD "sol3chek.bsv", VARPTR(Chek(0))
|
|
DEF SEG = VARSEG(Numbers(0))
|
|
BLOAD "sol3nums.bsv", VARPTR(Numbers(0))
|
|
DEF SEG = VARSEG(MenuGFX(0))
|
|
BLOAD "sol3men1.bsv", VARPTR(MenuGFX(0))
|
|
DEF SEG
|
|
|
|
'Create and load MouseDATA$ for CALL ABSOLUTE routines
|
|
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B,5E,08,8B
|
|
DATA 0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53,8B,5E,0C,89,07,58
|
|
DATA 8B,5E,0A,89,07,8B,5E,08,89,0F,8B,5E,06,89,17,5D,CA,08,00
|
|
MouseDATA$ = SPACE$(57)
|
|
FOR i = 1 TO 57
|
|
READ h$
|
|
Hexxer$ = CHR$(VAL("&H" + h$))
|
|
MID$(MouseDATA$, i, 1) = Hexxer$
|
|
NEXT i
|
|
Moused = InitMOUSE
|
|
IF NOT Moused THEN
|
|
PRINT "Sorry, cat must have got the mouse."
|
|
SLEEP 2
|
|
SYSTEM
|
|
END IF
|
|
|
|
SCREEN 12
|
|
|
|
GOSUB SetPALETTE
|
|
DrawSCREEN 1
|
|
InitVALS
|
|
RANDOMIZE TIMER
|
|
Sol3DEAL
|
|
ShowMOUSE
|
|
|
|
DO
|
|
Beginning:
|
|
MouseSTATUS LB, RB, MouseX, MouseY
|
|
IF Menu > 2 THEN Sol3MENU 1: GOTO Beginning
|
|
SELECT CASE MouseY
|
|
CASE IS < 18
|
|
IF MouseX > 621 AND LB THEN CheckOUT
|
|
IF Menu THEN Sol3MENU 0
|
|
CASE 20 TO 35
|
|
SELECT CASE MouseX
|
|
CASE IS < 103
|
|
Sol3MENU 1
|
|
CASE ELSE
|
|
IF Menu THEN Sol3MENU 0
|
|
END SELECT
|
|
CASE IS > 38
|
|
IF Menu THEN Sol3MENU 0
|
|
PlayGAME
|
|
Finito
|
|
END SELECT
|
|
PauseMOUSE LB, RB, MouseX, MouseY
|
|
LOOP
|
|
|
|
SYSTEM
|
|
|
|
SetPALETTE:
|
|
DATA 0, 0, 0, 16, 16, 32, 21, 63, 21, 63, 63, 0
|
|
DATA 63, 0, 0, 28, 28, 28, 0, 34, 0, 63, 50, 10
|
|
DATA 0, 30, 55, 45, 50, 63, 0, 63, 63, 0, 42, 0
|
|
DATA 63, 45, 55, 63, 30, 40, 48, 48, 48, 63, 63, 63
|
|
RESTORE SetPALETTE
|
|
OUT &H3C8, 0
|
|
FOR n = 1 TO 48
|
|
READ Intensity
|
|
OUT &H3C9, Intensity
|
|
NEXT n
|
|
RETURN
|
|
|
|
SUB CheckOUT
|
|
|
|
HideMOUSE
|
|
PUT (622, 2), Buttons(400), PSET
|
|
ShowMOUSE
|
|
|
|
Interval .1
|
|
|
|
HideMOUSE
|
|
PUT (588, 2), Buttons, PSET
|
|
ShowMOUSE
|
|
|
|
Interval .1
|
|
|
|
SYSTEM
|
|
|
|
END SUB
|
|
|
|
SUB CheckTOTAL
|
|
SHARED Deck1, Deck2, Deck3, Deck4
|
|
|
|
IF Vegas = 0 THEN
|
|
IF Deck1 = 0 THEN
|
|
IF Deck2 = 0 THEN
|
|
IF Deck3 = 0 THEN
|
|
HideMOUSE
|
|
IF Deck4 > 0 THEN
|
|
Deck1 = Deck4
|
|
PUT (5, 43), CardBACK, PSET
|
|
END IF
|
|
IF Deck4 > 8 THEN
|
|
Deck1 = 8
|
|
Deck2 = Deck4 - 8
|
|
PUT (83, 43), CardBACK, PSET
|
|
END IF
|
|
IF Deck4 > 16 THEN
|
|
Deck1 = 8
|
|
Deck2 = 8
|
|
Deck3 = Deck4 - 16
|
|
PUT (161, 43), CardBACK, PSET
|
|
END IF
|
|
LINE (239, 43)-(313, 152), 11, BF
|
|
ShowMOUSE
|
|
FOR n = 1 TO Deck3
|
|
Decks(3, n).Value = TurnUPs(Deck4).Value
|
|
Decks(3, n).Suit = TurnUPs(Deck4).Suit
|
|
Deck4 = Deck4 - 1
|
|
NEXT n
|
|
FOR n = 1 TO Deck2
|
|
Decks(2, n).Value = TurnUPs(Deck4).Value
|
|
Decks(2, n).Suit = TurnUPs(Deck4).Suit
|
|
Deck4 = Deck4 - 1
|
|
NEXT n
|
|
FOR n = 1 TO Deck1
|
|
Decks(1, n).Value = TurnUPs(Deck4).Value
|
|
Decks(1, n).Suit = TurnUPs(Deck4).Suit
|
|
Deck4 = Deck4 - 1
|
|
NEXT n
|
|
Deck4 = 0
|
|
END IF
|
|
END IF
|
|
END IF
|
|
END IF
|
|
|
|
END SUB
|
|
|
|
SUB ClearMOUSE
|
|
SHARED LB
|
|
|
|
WHILE LB
|
|
MouseSTATUS LB, RB, MouseX, MouseY
|
|
WEND
|
|
|
|
END SUB
|
|
|
|
SUB DrawSCREEN (Mode)
|
|
|
|
HideMOUSE
|
|
IF Mode = 1 THEN
|
|
LINE (0, 0)-(639, 17), 1, BF
|
|
LINE (0, 18)-(639, 37), 14, BF
|
|
LINE (0, 38)-(639, 38), 0
|
|
PUT (588, 2), Buttons, PSET
|
|
PUT (20, 0), Title, PSET
|
|
PUT (20, 24), MenuGFX, PSET
|
|
PUT (73, 24), MenuGFX(100), PSET
|
|
PUT (532, 24), MenuGFX(400), PSET
|
|
END IF
|
|
|
|
LINE (0, 39)-(639, 479), 11, BF
|
|
LINE (0, 155)-(639, 155), 2
|
|
LINE (318, 39)-(318, 155), 2
|
|
LINE (321, 39)-(321, 154), 6
|
|
LINE (319, 155)-(320, 155), 11
|
|
PSET (321, 155), 8
|
|
|
|
Index = 1
|
|
FOR x = 326 TO 568 STEP 78
|
|
LINE (x, 43)-(x + 74, 151), 2, B
|
|
LINE (x, 43)-(x + 74, 43), 6
|
|
LINE (x, 43)-(x, 151), 6
|
|
LINE (x + 18, 73)-(x + 56, 121), 2, B
|
|
LINE (x + 18, 73)-(x + 56, 73), 6
|
|
LINE (x + 18, 73)-(x + 18, 121), 6
|
|
PUT (x + 25, 85), Suits(Index), PSET
|
|
Index = Index + 200
|
|
NEXT x
|
|
|
|
IF Vegas THEN SetSCORE
|
|
ShowMOUSE
|
|
|
|
END SUB
|
|
|
|
SUB Finito
|
|
IF Completed THEN EXIT SUB
|
|
IF Stacks(1).Value = 13 THEN
|
|
IF Stacks(2).Value = 13 THEN
|
|
IF Stacks(3).Value = 13 THEN
|
|
IF Stacks(4).Value = 13 THEN
|
|
HideMOUSE
|
|
PLAY "MBMST120O1L16ceg>ceg>ceg>L32cg"
|
|
PLAY "MBMST120O4L32cgcgcgcg"
|
|
FOR Reps = 1 TO 400
|
|
x = FIX(RND * 560)
|
|
y = FIX(RND * 370)
|
|
CardNUM = FIX(RND * 52) + 1
|
|
PutCARD x, y, CardNUM
|
|
NEXT Reps
|
|
ShowMOUSE
|
|
DrawSCREEN 1
|
|
PLAY "MBO1L16CEGC"
|
|
x = 30
|
|
FOR CardNUM = 1 TO 52
|
|
PutCARD x, 185, CardNUM
|
|
x = x + 10
|
|
NEXT CardNUM
|
|
COLOR 3
|
|
LINE (180, 230)-(470, 265), 0, BF
|
|
LINE (185, 235)-(465, 260), 4, B
|
|
LOCATE 16, 27: PRINT "C O N G R A T U L A T I O N S !"
|
|
Interval 2
|
|
DrawSCREEN 1
|
|
Completed = 1
|
|
END IF
|
|
END IF
|
|
END IF
|
|
END IF
|
|
|
|
END SUB
|
|
|
|
SUB HideMOUSE
|
|
|
|
LB = 2
|
|
MouseDRIVER LB, 0, 0, 0
|
|
|
|
END SUB
|
|
|
|
FUNCTION InitMOUSE
|
|
|
|
LB = 0
|
|
MouseDRIVER LB, 0, 0, 0
|
|
InitMOUSE = LB
|
|
|
|
END FUNCTION
|
|
|
|
SUB InitVALS
|
|
SHARED Menu
|
|
|
|
FOR n = 1 TO 52
|
|
Deck(n) = n
|
|
NEXT n
|
|
|
|
FOR Col = 1 TO 7
|
|
FOR Row = 1 TO 18
|
|
MainPLAY(Col, Row).x = (Col - 1) * 88 + 18
|
|
MainPLAY(Col, Row).y = (Row - 1) * 18 + 158
|
|
NEXT Row
|
|
NEXT Col
|
|
|
|
FOR Col = 1 TO 7
|
|
MainPLAY(Col, 0).x = (Col - 1) * 88 + 18
|
|
MainPLAY(Col, 0).y = 140
|
|
NEXT Col
|
|
|
|
END SUB
|
|
|
|
DEFSNG A-Z
|
|
SUB Interval (Length!)
|
|
|
|
OldTimer# = TIMER
|
|
DO: LOOP UNTIL TIMER > OldTimer# + Length!
|
|
|
|
END SUB
|
|
|
|
DEFINT A-Z
|
|
SUB MouseDRIVER (LB, RB, mX, mY)
|
|
|
|
DEF SEG = VARSEG(MouseDATA$)
|
|
Mouse = SADD(MouseDATA$)
|
|
CALL ABSOLUTE_MOUSE_EMU (LB, RB, MX, MY)
|
|
|
|
END SUB
|
|
|
|
SUB MouseSTATUS (LB, RB, MouseX, MouseY)
|
|
|
|
LB = 3
|
|
MouseDRIVER LB, RB, mX, mY
|
|
LB = ((RB AND 1) <> 0)
|
|
RB = ((RB AND 2) <> 0)
|
|
MouseX = mX
|
|
MouseY = mY
|
|
|
|
END SUB
|
|
|
|
SUB Navigate
|
|
END SUB
|
|
|
|
SUB PauseMOUSE (OldLB, OldRB, OldMX, OldMY)
|
|
SHARED Key$
|
|
|
|
DO
|
|
Key$ = UCASE$(INKEY$)
|
|
MouseSTATUS LB, RB, MouseX, MouseY
|
|
LOOP UNTIL LB <> OldLB OR RB <> OldRB OR MouseX <> OldMX OR MouseY <> OldMY OR Key$ <> ""
|
|
|
|
END SUB
|
|
|
|
SUB PlayGAME
|
|
SHARED LB, RB, MouseX, MouseY
|
|
SHARED Deck1, Deck2, Deck3, Deck4, CardSELECT
|
|
SHARED FCcol, FCrow, FCx, FCy, FCsuit, FCvalue, LastDECK
|
|
|
|
BackERASE(2) = 127: CardBACK(2) = 109: Selected(2) = 109
|
|
|
|
SELECT CASE MouseY
|
|
CASE 43 TO 151
|
|
SELECT CASE MouseX
|
|
CASE 7 TO 81 'first deck
|
|
IF LB THEN
|
|
IF CardSELECT THEN GOSUB ZeroTURNUPS
|
|
IF Deck1 > 0 THEN
|
|
CardNUM = (Decks(1, Deck1).Suit - 1) * 13 + Decks(1, Deck1).Value
|
|
HideMOUSE
|
|
PutCARD 239, 43, CardNUM
|
|
ShowMOUSE
|
|
Deck4 = Deck4 + 1
|
|
TurnUPs(Deck4).Suit = Decks(1, Deck1).Suit
|
|
TurnUPs(Deck4).Value = Decks(1, Deck1).Value
|
|
Decks(1, Deck1).Suit = 0
|
|
Decks(1, Deck1).Value = 0
|
|
Deck1 = Deck1 - 1
|
|
LastDECK = 1
|
|
IF Deck1 = 0 THEN
|
|
HideMOUSE
|
|
LINE (5, 43)-(79, 152), 11, BF
|
|
IF Vegas = 0 THEN
|
|
LINE (24, 73)-(62, 121), 2, B
|
|
LINE (26, 75)-(60, 119), 2, BF
|
|
END IF
|
|
ShowMOUSE
|
|
END IF
|
|
ELSE
|
|
CheckTOTAL
|
|
END IF
|
|
ClearMOUSE
|
|
END IF
|
|
CASE 85 TO 159 'second deck
|
|
IF LB THEN
|
|
IF CardSELECT THEN GOSUB ZeroTURNUPS
|
|
IF Deck2 > 0 THEN
|
|
CardNUM = (Decks(2, Deck2).Suit - 1) * 13 + Decks(2, Deck2).Value
|
|
HideMOUSE
|
|
PutCARD 239, 43, CardNUM
|
|
ShowMOUSE
|
|
Deck4 = Deck4 + 1
|
|
TurnUPs(Deck4).Suit = Decks(2, Deck2).Suit
|
|
TurnUPs(Deck4).Value = Decks(2, Deck2).Value
|
|
Decks(2, Deck2).Suit = 0
|
|
Decks(2, Deck2).Value = 0
|
|
Deck2 = Deck2 - 1
|
|
LastDECK = 2
|
|
IF Deck2 = 0 THEN
|
|
HideMOUSE
|
|
LINE (83, 43)-(157, 152), 11, BF
|
|
IF Vegas = 0 THEN
|
|
LINE (102, 73)-(140, 121), 2, B
|
|
LINE (104, 75)-(138, 119), 2, BF
|
|
END IF
|
|
ShowMOUSE
|
|
END IF
|
|
ELSE
|
|
CheckTOTAL
|
|
END IF
|
|
ClearMOUSE
|
|
END IF
|
|
CASE 163 TO 237 'third deck
|
|
IF LB THEN
|
|
IF CardSELECT THEN GOSUB ZeroTURNUPS
|
|
IF Deck3 > 0 THEN
|
|
CardNUM = (Decks(3, Deck3).Suit - 1) * 13 + Decks(3, Deck3).Value
|
|
HideMOUSE
|
|
PutCARD 239, 43, CardNUM
|
|
ShowMOUSE
|
|
Deck4 = Deck4 + 1
|
|
TurnUPs(Deck4).Suit = Decks(3, Deck3).Suit
|
|
TurnUPs(Deck4).Value = Decks(3, Deck3).Value
|
|
Decks(3, Deck3).Suit = 0
|
|
Decks(3, Deck3).Value = 0
|
|
Deck3 = Deck3 - 1
|
|
LastDECK = 3
|
|
IF Deck3 = 0 THEN
|
|
HideMOUSE
|
|
LINE (161, 43)-(235, 152), 11, BF
|
|
IF Vegas = 0 THEN
|
|
LINE (180, 73)-(218, 121), 2, B
|
|
LINE (182, 75)-(216, 119), 2, BF
|
|
END IF
|
|
ShowMOUSE
|
|
END IF
|
|
ELSE
|
|
CheckTOTAL
|
|
END IF
|
|
ClearMOUSE
|
|
END IF
|
|
CASE 241 TO 319 'turn-up deck
|
|
IF Deck4 > 0 THEN
|
|
IF LB THEN
|
|
IF CardSELECT = 0 THEN
|
|
TSuit = TurnUPs(Deck4).Suit
|
|
TValue = TurnUPs(Deck4).Value
|
|
CardNUM = (TSuit - 1) * 13 + TValue
|
|
IF (CardNUM = MoneyCARD) AND Money THEN
|
|
HideMOUSE
|
|
PutCARD 239, 43, CardNUM
|
|
PLAY "MBT140O6L64GP32GP32GP32GP32GP32GP32GP32G"
|
|
Score = Score + 52 + Tally: SetSCORE
|
|
Tally = Tally + 5
|
|
MoneyCARD = 0
|
|
GOSUB ZeroVALS
|
|
ShowMOUSE
|
|
EXIT SUB
|
|
END IF
|
|
HideMOUSE
|
|
PUT (239, 43), Selected
|
|
ShowMOUSE
|
|
CardSELECT = 2
|
|
ELSE
|
|
HideMOUSE
|
|
IF CardSELECT = 2 THEN
|
|
TSuit = TurnUPs(Deck4).Suit
|
|
TValue = TurnUPs(Deck4).Value
|
|
CardNUM = (TSuit - 1) * 13 + TValue
|
|
IF (CardNUM = MoneyCARD) AND Money THEN
|
|
PutCARD 239, 43, CardNUM
|
|
PLAY "MBT140O6L64GP32GP32GP32GP32GP32GP32GP32G"
|
|
MoneyCARD = 0
|
|
GOSUB ZeroVALS
|
|
ShowMOUSE
|
|
EXIT SUB
|
|
END IF
|
|
IF Stacks(TSuit).Value = TValue - 1 THEN
|
|
IF TurnUPs(Deck4 - 1).Value <> 0 THEN
|
|
CardNUM = (TurnUPs(Deck4 - 1).Suit - 1) * 13 + TurnUPs(Deck4 - 1).Value
|
|
PutCARD 239, 43, CardNUM
|
|
ELSE
|
|
LINE (239, 43)-(313, 152), 11, BF
|
|
END IF
|
|
CardNUM = (TSuit - 1) * 13 + TValue
|
|
PutCARD ((TSuit - 1) * 78 + 325), 43, CardNUM
|
|
Score = Score + 5: Tally = Tally + 5
|
|
IF Vegas THEN SetSCORE
|
|
ShowMOUSE
|
|
Stacks(TSuit).Value = Stacks(TSuit).Value + 1
|
|
TurnUPs(Deck4).Suit = 0
|
|
TurnUPs(Deck4).Value = 0
|
|
Deck4 = Deck4 - 1
|
|
GOSUB ZeroVALS
|
|
ELSE
|
|
PUT (239, 43), Selected
|
|
GOSUB ZeroVALS
|
|
END IF
|
|
ELSE
|
|
PUT (FCx, FCy), Selected
|
|
GOSUB ZeroVALS
|
|
END IF
|
|
ShowMOUSE
|
|
END IF
|
|
ClearMOUSE
|
|
END IF
|
|
END IF
|
|
END SELECT
|
|
CASE IS > 159 'columns y
|
|
SELECT CASE MouseX
|
|
CASE 18 TO 92 'column 1
|
|
IF LB THEN
|
|
Column = 1
|
|
IF CardSELECT = 0 THEN
|
|
GOSUB SELECT1
|
|
ELSE
|
|
GOSUB SELECT2
|
|
END IF
|
|
END IF
|
|
CASE 106 TO 180 'column 2
|
|
IF LB THEN
|
|
Column = 2
|
|
IF CardSELECT = 0 THEN
|
|
GOSUB SELECT1
|
|
ELSE
|
|
GOSUB SELECT2
|
|
END IF
|
|
END IF
|
|
CASE 194 TO 268 'column 3
|
|
IF LB THEN
|
|
Column = 3
|
|
IF CardSELECT = 0 THEN
|
|
GOSUB SELECT1
|
|
ELSE
|
|
GOSUB SELECT2
|
|
END IF
|
|
END IF
|
|
CASE 282 TO 356 'column 4
|
|
IF LB THEN
|
|
Column = 4
|
|
IF CardSELECT = 0 THEN
|
|
GOSUB SELECT1
|
|
ELSE
|
|
GOSUB SELECT2
|
|
END IF
|
|
END IF
|
|
CASE 370 TO 444 'column 5
|
|
IF LB THEN
|
|
Column = 5
|
|
IF CardSELECT = 0 THEN
|
|
GOSUB SELECT1
|
|
ELSE
|
|
GOSUB SELECT2
|
|
END IF
|
|
END IF
|
|
CASE 458 TO 532 'column 6
|
|
IF LB THEN
|
|
Column = 6
|
|
IF CardSELECT = 0 THEN
|
|
GOSUB SELECT1
|
|
ELSE
|
|
GOSUB SELECT2
|
|
END IF
|
|
END IF
|
|
CASE 546 TO 620 'column 7
|
|
IF LB THEN
|
|
Column = 7
|
|
IF CardSELECT = 0 THEN
|
|
GOSUB SELECT1
|
|
ELSE
|
|
GOSUB SELECT2
|
|
END IF
|
|
END IF
|
|
END SELECT
|
|
END SELECT
|
|
ClearMOUSE
|
|
EXIT SUB
|
|
|
|
'*************************** FIRST SELECTION SUBROUTINE **********************
|
|
SELECT1:
|
|
LastDECK = 0
|
|
FCcol = Column
|
|
FOR FCrow = 18 TO 1 STEP -1
|
|
IF MainPLAY(FCcol, FCrow).Value <> 0 THEN
|
|
IF MainPLAY(FCcol, FCrow).UpDOWN = 0 THEN
|
|
cn = (MainPLAY(FCcol, FCrow).Suit - 1) * 13 + MainPLAY(FCcol, FCrow).Value
|
|
CardNUM = cn
|
|
FCx = MainPLAY(FCcol, FCrow).x
|
|
FCy = MainPLAY(FCcol, FCrow).y
|
|
HideMOUSE
|
|
PutCARD FCx, FCy, CardNUM
|
|
ShowMOUSE
|
|
MainPLAY(FCcol, FCrow).UpDOWN = 1
|
|
GOSUB ZeroVALS
|
|
ClearMOUSE
|
|
RETURN
|
|
ELSE
|
|
FCsuit = MainPLAY(FCcol, FCrow).Suit
|
|
FCvalue = MainPLAY(FCcol, FCrow).Value
|
|
FCx = MainPLAY(FCcol, FCrow).x
|
|
FCy = MainPLAY(FCcol, FCrow).y
|
|
IF FCy + 108 < 479 THEN Selected(2) = 109 ELSE Selected(2) = 480 - FCy
|
|
HideMOUSE
|
|
PUT (FCx, FCy), Selected
|
|
ShowMOUSE
|
|
CardSELECT = 1
|
|
ClearMOUSE
|
|
RETURN
|
|
END IF
|
|
END IF
|
|
NEXT FCrow
|
|
RETURN
|
|
|
|
'************************* SECOND SELECTION SUBROUTINE ***********************
|
|
|
|
SELECT2:
|
|
LastDECK = 0
|
|
SCcol = Column
|
|
IF CardSELECT = 1 THEN
|
|
HideMOUSE
|
|
IF FCcol = SCcol OR FCvalue = 1 THEN
|
|
IF Stacks(FCsuit).Value = FCvalue - 1 THEN
|
|
GOSUB LiftCARD
|
|
CardNUM = (FCsuit - 1) * 13 + FCvalue
|
|
PutCARD ((FCsuit - 1) * 78 + 325), 43, CardNUM
|
|
Stacks(FCsuit).Value = Stacks(FCsuit).Value + 1
|
|
MainPLAY(FCcol, FCrow).Value = 0
|
|
MainPLAY(FCcol, FCrow).Suit = 0
|
|
GOSUB ZeroVALS
|
|
Score = Score + 5: Tally = Tally + 5
|
|
IF Vegas THEN SetSCORE
|
|
ShowMOUSE
|
|
ClearMOUSE
|
|
RETURN
|
|
ELSE
|
|
IF FCy + 108 < 479 THEN Selected(2) = 109 ELSE Selected(2) = 480 - FCy
|
|
PUT (FCx, FCy), Selected
|
|
GOSUB ZeroVALS
|
|
ShowMOUSE
|
|
ClearMOUSE
|
|
RETURN
|
|
END IF
|
|
ELSE
|
|
FOR SCrow = 18 TO 1 STEP -1
|
|
IF MainPLAY(SCcol, SCrow).Value <> 0 THEN EXIT FOR
|
|
NEXT SCrow
|
|
|
|
IF SCrow = 0 THEN
|
|
IF FCvalue = 13 THEN
|
|
GOSUB LiftCARD
|
|
CardNUM = (MainPLAY(FCcol, FCrow).Suit - 1) * 13 + 13
|
|
PutCARD MainPLAY(SCcol, 1).x, MainPLAY(SCcol, 1).y, CardNUM
|
|
ShowMOUSE
|
|
MainPLAY(SCcol, 1).Suit = FCsuit
|
|
MainPLAY(SCcol, 1).Value = 13
|
|
MainPLAY(FCcol, FCrow).Suit = 0
|
|
MainPLAY(FCcol, FCrow).Value = 0
|
|
GOSUB ZeroVALS
|
|
ClearMOUSE
|
|
RETURN
|
|
ELSE
|
|
FOR Reduce = FCrow TO 0 STEP -1
|
|
IF MainPLAY(FCcol, Reduce).UpDOWN = 1 THEN
|
|
IF MainPLAY(FCcol, Reduce).Value = 13 THEN
|
|
SCrow = 0
|
|
MatchCARD = Reduce
|
|
GOTO TrickHANDLER
|
|
END IF
|
|
END IF
|
|
NEXT Reduce
|
|
|
|
IF FCy + 108 > 479 THEN Selected(2) = 480 - FCx ELSE Selected(2) = 109
|
|
PUT (FCx, FCy), Selected
|
|
ShowMOUSE
|
|
GOSUB ZeroVALS
|
|
ClearMOUSE
|
|
RETURN
|
|
END IF
|
|
END IF
|
|
|
|
|
|
FOR MatchCARD = FCrow TO 0 STEP -1
|
|
IF MainPLAY(FCcol, MatchCARD).UpDOWN = 1 THEN
|
|
FCsuit = MainPLAY(FCcol, MatchCARD).Suit
|
|
FCvalue = MainPLAY(FCcol, MatchCARD).Value
|
|
|
|
IF FCvalue + 1 = MainPLAY(SCcol, SCrow).Value OR FCrow = 0 THEN
|
|
IF MainPLAY(SCcol, SCrow).Suit MOD 2 <> FCsuit MOD 2 THEN
|
|
IF MatchCARD < FCrow THEN
|
|
ERASE Trick
|
|
TrickHANDLER:
|
|
FOR Row = FCrow - 1 TO MatchCARD - 1 STEP -1
|
|
Ex = MainPLAY(FCcol, Row).x
|
|
Ey = MainPLAY(FCcol, Row).y
|
|
IF MainPLAY(FCcol, Row).UpDOWN = 1 THEN
|
|
EraseNUM = (MainPLAY(FCcol, Row).Suit - 1) * 13 + MainPLAY(FCcol, Row).Value
|
|
PutCARD Ex, Ey, EraseNUM
|
|
LINE (Ex, Ey + 109)-(Ex + 74, Ey + 127), 11, BF
|
|
ELSE
|
|
IF MainPLAY(FCcol, Row).Value = 0 THEN
|
|
LINE ((FCcol - 1) * 88 + 18, 158)-((FCcol - 1) * 88 + 92, 284), 11, BF
|
|
ELSE
|
|
IF Ey + 109 > 479 THEN
|
|
BackERASE(2) = 480 - Ey
|
|
ELSE
|
|
BackERASE(2) = 127
|
|
END IF
|
|
IF POINT(Ex + 1, Ey - 1) = 15 THEN OnTOP = 1
|
|
PUT (Ex, Ey), BackERASE, PSET
|
|
IF OnTOP THEN PUT (Ex, Ey), TopOFF, PSET
|
|
END IF
|
|
END IF
|
|
Count = Count + 1
|
|
Trick(Count).Suit = MainPLAY(FCcol, Row + 1).Suit
|
|
Trick(Count).Value = MainPLAY(FCcol, Row + 1).Value
|
|
MainPLAY(FCcol, Row + 1).Suit = 0
|
|
MainPLAY(FCcol, Row + 1).Value = 0
|
|
NEXT Row
|
|
x = MainPLAY(SCcol, SCrow).x
|
|
y = MainPLAY(SCcol, SCrow).y
|
|
FOR Cards = FCrow - MatchCARD + 1 TO 1 STEP -1
|
|
CardNUM = (Trick(Cards).Suit - 1) * 13 + Trick(Cards).Value
|
|
Slot = Slot + 1
|
|
MainPLAY(SCcol, SCrow + Slot).Suit = Trick(Cards).Suit
|
|
MainPLAY(SCcol, SCrow + Slot).Value = Trick(Cards).Value
|
|
MainPLAY(SCcol, SCrow + Slot).UpDOWN = 1
|
|
y = y + 18
|
|
PutCARD x, y, CardNUM
|
|
NEXT Cards
|
|
ShowMOUSE
|
|
ClearMOUSE
|
|
GOSUB ZeroVALS
|
|
RETURN
|
|
ELSE
|
|
GOSUB LiftCARD
|
|
CardNUM = (FCsuit - 1) * 13 + FCvalue
|
|
|
|
NCx = MainPLAY(SCcol, SCrow).x
|
|
NCy = MainPLAY(SCcol, SCrow + 1).y
|
|
|
|
PutCARD NCx, NCy, CardNUM
|
|
|
|
ShowMOUSE
|
|
ClearMOUSE
|
|
|
|
MainPLAY(SCcol, SCrow + 1).Suit = FCsuit
|
|
MainPLAY(SCcol, SCrow + 1).Value = FCvalue
|
|
MainPLAY(SCcol, SCrow + 1).UpDOWN = 1
|
|
|
|
MainPLAY(FCcol, FCrow).Suit = 0
|
|
MainPLAY(FCcol, FCrow).Value = 0
|
|
GOSUB ZeroVALS
|
|
RETURN
|
|
END IF
|
|
END IF
|
|
END IF
|
|
END IF
|
|
NEXT MatchCARD
|
|
IF FCy + 108 > 479 THEN Selected(2) = 480 - FCx ELSE Selected(2) = 109
|
|
PUT (FCx, FCy), Selected
|
|
GOSUB ZeroVALS
|
|
ShowMOUSE
|
|
ClearMOUSE
|
|
RETURN
|
|
END IF
|
|
|
|
ELSE 'CardSELECT = 2
|
|
|
|
FOR SCrow = 18 TO 1 STEP -1
|
|
IF MainPLAY(SCcol, SCrow).Value <> 0 THEN EXIT FOR
|
|
NEXT SCrow
|
|
|
|
IF SCrow = 0 THEN
|
|
HideMOUSE
|
|
IF TurnUPs(Deck4).Value = 13 THEN
|
|
IF Deck4 > 1 THEN
|
|
CardNUM = (TurnUPs(Deck4 - 1).Suit - 1) * 13 + TurnUPs(Deck4 - 1).Value
|
|
PutCARD 239, 43, CardNUM
|
|
ELSE
|
|
LINE (239, 43)-(313, 153), 11, BF
|
|
END IF
|
|
CardNUM = (TurnUPs(Deck4).Suit - 1) * 13 + 13
|
|
PutCARD MainPLAY(SCcol, 1).x, 158, CardNUM
|
|
ShowMOUSE
|
|
MainPLAY(SCcol, 1).Suit = TurnUPs(Deck4).Suit
|
|
MainPLAY(SCcol, 1).Value = TurnUPs(Deck4).Value
|
|
TurnUPs(Deck4).Suit = 0
|
|
TurnUPs(Deck4).Value = 0
|
|
Deck4 = Deck4 - 1
|
|
GOSUB ZeroVALS
|
|
ClearMOUSE
|
|
RETURN
|
|
END IF
|
|
ShowMOUSE
|
|
END IF
|
|
|
|
HideMOUSE
|
|
IF TurnUPs(Deck4).Suit MOD 2 <> MainPLAY(SCcol, SCrow).Suit MOD 2 THEN
|
|
IF TurnUPs(Deck4).Value + 1 = MainPLAY(SCcol, SCrow).Value THEN
|
|
PUT (239, 43), Selected
|
|
TopcardNUM = (TurnUPs(Deck4).Suit - 1) * 13 + TurnUPs(Deck4).Value
|
|
SCsuit = TurnUPs(Deck4).Suit
|
|
SCvalue = TurnUPs(Deck4).Value
|
|
TurnUPs(Deck4).Suit = 0
|
|
TurnUPs(Deck4).Value = 0
|
|
IF Deck4 > 0 THEN
|
|
Deck4 = Deck4 - 1
|
|
IF Deck4 = 0 THEN
|
|
LINE (239, 43)-(313, 152), 11, BF
|
|
ELSE
|
|
CardNUM = (TurnUPs(Deck4).Suit - 1) * 13 + TurnUPs(Deck4).Value
|
|
PutCARD 239, 43, CardNUM
|
|
END IF
|
|
PutCARD MainPLAY(SCcol, SCrow).x, MainPLAY(SCcol, SCrow + 1).y, TopcardNUM
|
|
ShowMOUSE
|
|
MainPLAY(SCcol, SCrow + 1).Suit = SCsuit
|
|
MainPLAY(SCcol, SCrow + 1).Value = SCvalue
|
|
MainPLAY(SCcol, SCrow + 1).UpDOWN = 1
|
|
GOSUB ZeroVALS
|
|
ClearMOUSE
|
|
RETURN
|
|
ELSE
|
|
LINE (239, 43)-(315, 152), 11, BF
|
|
ShowMOUSE
|
|
GOSUB ZeroVALS
|
|
ClearMOUSE
|
|
RETURN
|
|
END IF
|
|
ELSE
|
|
PUT (239, 43), Selected
|
|
GOSUB ZeroVALS
|
|
ShowMOUSE
|
|
ClearMOUSE
|
|
RETURN
|
|
END IF
|
|
ELSE
|
|
PUT (239, 43), Selected
|
|
GOSUB ZeroVALS
|
|
ShowMOUSE
|
|
ClearMOUSE
|
|
RETURN
|
|
END IF
|
|
END IF
|
|
|
|
RETURN
|
|
|
|
ZeroVALS:
|
|
FCcol = 0: FCrow = 0: FCx = 0: FCy = 0: FCsuit = 0: FCvalue = 0: Column = 0: CardSELECT = 0
|
|
RETURN
|
|
|
|
LiftCARD:
|
|
IF FCrow = 1 THEN
|
|
LINE ((FCcol - 1) * 88 + 18, 158)-((FCcol - 1) * 88 + 92, 266), 11, BF
|
|
ELSE
|
|
IF MainPLAY(FCcol, FCrow - 1).UpDOWN = 1 THEN
|
|
CardNUM = (MainPLAY(FCcol, FCrow - 1).Suit - 1) * 13 + MainPLAY(FCcol, FCrow - 1).Value
|
|
PutCARD FCx, FCy - 18, CardNUM
|
|
LINE (FCx, FCy + 91)-(FCx + 74, FCy + 109), 11, BF
|
|
ELSE
|
|
IF FCy + 109 < 479 THEN BackERASE(2) = 127 ELSE BackERASE(2) = 479 - FCy
|
|
IF POINT(FCx + 1, FCy - 19) = 15 THEN OnTOP = 1
|
|
PUT (FCx, FCy - 18), BackERASE, PSET
|
|
IF OnTOP THEN PUT (FCx, FCy - 18), TopOFF, PSET
|
|
END IF
|
|
END IF
|
|
RETURN
|
|
|
|
ZeroTURNUPS:
|
|
HideMOUSE
|
|
IF FCy + 108 > 479 THEN Selected(2) = 480 - FCx ELSE Selected(2) = 109
|
|
IF CardSELECT = 1 THEN PUT (FCx, FCy), Selected
|
|
ShowMOUSE
|
|
GOSUB ZeroVALS
|
|
RETURN
|
|
|
|
END SUB
|
|
|
|
SUB PutCARD (x, y, CardNUM)
|
|
SHARED HoldNUM, Dealt
|
|
|
|
IF Money THEN
|
|
IF HoldNUM = CardNUM THEN Dealt = 1
|
|
IF CardNUM = MoneyCARD AND Dealt = 0 THEN
|
|
HoldNUM = CardNUM
|
|
CardNUM = 55
|
|
END IF
|
|
END IF
|
|
|
|
FileNAME$ = "Sol3CD" + LTRIM$(RTRIM$(STR$(CardNUM))) + ".BSV"
|
|
DEF SEG = VARSEG(Card(1))
|
|
BLOAD FileNAME$, VARPTR(Card(1))
|
|
DEF SEG
|
|
IF POINT(x + 1, y - 1) = 15 THEN OnTOP = 1 'Check for underlying card...
|
|
IF y + 108 > 479 THEN Card(2) = 480 - y ELSE Card(2) = 109
|
|
PUT (x, y), Card, PSET
|
|
IF OnTOP THEN PUT (x, y), TopOFF, PSET 'Place B/W card top if required
|
|
|
|
END SUB
|
|
|
|
SUB SetSCORE
|
|
|
|
IF Score < 0 THEN
|
|
PrintSCORE& = Score - Score * 2
|
|
Minus = 1
|
|
ELSE
|
|
PrintSCORE& = Score
|
|
END IF
|
|
Scor$ = "$" + LTRIM$(RTRIM$(STR$(PrintSCORE&)))
|
|
LINE (564, 23)-(631, 34), 14, BF
|
|
x = 572
|
|
IF Minus THEN LINE (566, 29)-(571, 29), 4
|
|
FOR n = 1 TO LEN(Scor$)
|
|
Char$ = MID$(Scor$, n, 1)
|
|
IF Char$ = "$" THEN
|
|
Index = 500
|
|
ELSE
|
|
Index = VAL(Char$) * 50
|
|
END IF
|
|
IF Minus THEN Index = Index + 550
|
|
PUT (x, 23), Numbers(Index), PSET
|
|
x = x + 7
|
|
NEXT n
|
|
IF Minus THEN Index = 550: Colr = 4 ELSE Index = 0: Colr = 2
|
|
LINE (x + 1, 31)-(x + 2, 32), Colr, B
|
|
PUT (x + 5, 23), Numbers(Index), PSET
|
|
PUT (x + 12, 23), Numbers(Index), PSET
|
|
END SUB
|
|
|
|
SUB ShowMOUSE
|
|
LB = 1
|
|
MouseDRIVER LB, 0, 0, 0
|
|
END SUB
|
|
|
|
SUB Sol3DEAL
|
|
SHARED Deck1, Deck2, Deck3, Deck4
|
|
SHARED FCcol, FCrow, FCx, FCy, FCsuit, FCvalue, CardSELECT
|
|
SHARED HoldNUM, Dealt
|
|
|
|
DrawSCREEN 2
|
|
ERASE Stacks: Completed = 0
|
|
HoldNUM = 0: Dealt = 0
|
|
|
|
HideMOUSE
|
|
FOR x = 5 TO 161 STEP 78
|
|
PUT (x, 43), CardBACK, PSET
|
|
NEXT x
|
|
ShowMOUSE
|
|
|
|
FOR Col = 1 TO 7
|
|
FOR Row = 1 TO 18
|
|
MainPLAY(Col, Row).Suit = 0
|
|
MainPLAY(Col, Row).Value = 0
|
|
MainPLAY(Col, Row).UpDOWN = 0
|
|
NEXT Row
|
|
NEXT Col
|
|
|
|
'Shuffle cards
|
|
FOR n = 52 TO 2 STEP -1
|
|
Card = INT(RND * n) + 1
|
|
SWAP Deck(n), Deck(Card)
|
|
NEXT n
|
|
|
|
MoneyNUM = FIX(RND * 24) + 29
|
|
MoneyCARD = Deck(MoneyNUM)
|
|
|
|
FOR Row = 1 TO 7
|
|
FOR Col = Row TO 7
|
|
PasteBOARD = PasteBOARD + 1
|
|
DeckVALUE = Deck(PasteBOARD)
|
|
SELECT CASE DeckVALUE
|
|
CASE 1 TO 13
|
|
MainPLAY(Col, Row).Suit = 1
|
|
MainPLAY(Col, Row).Value = DeckVALUE
|
|
CASE 14 TO 26
|
|
MainPLAY(Col, Row).Suit = 2
|
|
MainPLAY(Col, Row).Value = DeckVALUE - 13
|
|
CASE 27 TO 39
|
|
MainPLAY(Col, Row).Suit = 3
|
|
MainPLAY(Col, Row).Value = DeckVALUE - 26
|
|
CASE 40 TO 52
|
|
MainPLAY(Col, Row).Suit = 4
|
|
MainPLAY(Col, Row).Value = DeckVALUE - 39
|
|
END SELECT
|
|
Value = Deck(PasteBOARD) MOD 13
|
|
IF Value = 0 THEN Value = 13
|
|
MainPLAY(Col, Row).Value = Value
|
|
x = MainPLAY(Col, Row).x
|
|
y = MainPLAY(Col, Row).y
|
|
HideMOUSE
|
|
IF Row = Col THEN
|
|
MainPLAY(Col, Row).UpDOWN = 1
|
|
PutCARD x, y, DeckVALUE
|
|
ELSE
|
|
MainPLAY(Row, Col).UpDOWN = 0
|
|
IF POINT(x + 1, y - 1) = 15 THEN OnTOP = 1 ELSE OnTOP = 0
|
|
PUT (x, y), CardBACK, PSET
|
|
IF OnTOP THEN PUT (x, y), TopOFF, PSET
|
|
END IF
|
|
ShowMOUSE
|
|
NEXT Col
|
|
NEXT Row
|
|
|
|
FOR Col = 1 TO 3
|
|
FOR Num = 1 TO 8
|
|
PasteBOARD = PasteBOARD + 1
|
|
DeckVALUE = Deck(PasteBOARD)
|
|
SELECT CASE DeckVALUE
|
|
CASE 1 TO 13
|
|
Decks(Col, Num).Suit = 1
|
|
Decks(Col, Num).Value = DeckVALUE
|
|
CASE 14 TO 26
|
|
Decks(Col, Num).Suit = 2
|
|
Decks(Col, Num).Value = DeckVALUE - 13
|
|
CASE 27 TO 39
|
|
Decks(Col, Num).Suit = 3
|
|
Decks(Col, Num).Value = DeckVALUE - 26
|
|
CASE 40 TO 52
|
|
Decks(Col, Num).Suit = 4
|
|
Decks(Col, Num).Value = DeckVALUE - 39
|
|
END SELECT
|
|
NEXT Num
|
|
NEXT Col
|
|
|
|
Deck1 = 8: Deck2 = 8: Deck3 = 8: Deck4 = 0: CardSELECT = 0
|
|
FCcol = 0: FCrow = 0: FCx = 0: FCy = 0: FCsuit = 0: FCvalue = 0
|
|
|
|
Score = Score - 52: Tally = -52
|
|
IF Vegas THEN SetSCORE ELSE Score = 0
|
|
|
|
END SUB
|
|
|
|
SUB Sol3HELP (Item)
|
|
SHARED LB
|
|
|
|
GET (194, 80)-(446, 203), GetBOX
|
|
SELECT CASE Item
|
|
CASE 1 'Introduction
|
|
FirstPAGE = 1: LastPAGE = 5
|
|
CASE 2 'Basic Solitaire
|
|
FirstPAGE = 6: LastPAGE = 11
|
|
CASE 3 'Game Options
|
|
FirstPAGE = 12: LastPAGE = 15
|
|
CASE 4 'About Solitaire 3
|
|
HideMOUSE
|
|
DEF SEG = VARSEG(OtherBOX(0))
|
|
BLOAD "sol3hp16.bsv", VARPTR(OtherBOX(0))
|
|
DEF SEG
|
|
PUT (194, 80), OtherBOX, PSET
|
|
ShowMOUSE
|
|
END SELECT
|
|
IF Item <> 4 THEN CurrentPAGE = FirstPAGE: GOSUB PutHELP
|
|
|
|
DO
|
|
MouseSTATUS LB, RB, MouseX, MouseY
|
|
IF MouseY > 85 AND MouseY < 100 THEN
|
|
SELECT CASE MouseX
|
|
CASE 389 TO 403 'Left arrow button
|
|
IF LB = -1 THEN
|
|
IF CurrentPAGE > FirstPAGE THEN
|
|
CurrentPAGE = CurrentPAGE - 1
|
|
GOSUB PutHELP
|
|
END IF
|
|
END IF
|
|
CASE 405 TO 419 'Right arrow button
|
|
IF LB = -1 THEN
|
|
IF CurrentPAGE < LastPAGE THEN
|
|
CurrentPAGE = CurrentPAGE + 1
|
|
GOSUB PutHELP
|
|
END IF
|
|
END IF
|
|
CASE 423 TO 437 'Close button
|
|
IF LB = -1 THEN
|
|
GOSUB CloseHELP
|
|
EXIT DO
|
|
END IF
|
|
END SELECT
|
|
END IF
|
|
ClearMOUSE
|
|
PauseMOUSE LB, RB, MouseX, MouseY
|
|
LOOP
|
|
|
|
EXIT SUB
|
|
|
|
CloseHELP:
|
|
HideMOUSE
|
|
GET (423, 86)-(437, 99), Buttons(500)
|
|
PUT (423, 86), Buttons(400), PSET
|
|
ShowMOUSE
|
|
Interval .1
|
|
HideMOUSE
|
|
PUT (423, 86), Buttons(500), PSET
|
|
PUT (194, 80), GetBOX, PSET
|
|
ShowMOUSE
|
|
ClearMOUSE
|
|
RETURN
|
|
|
|
DoARROWS:
|
|
HideMOUSE
|
|
IF CurrentPAGE > FirstPAGE THEN
|
|
PAINT (396, 92), 15, 14
|
|
ELSE
|
|
PAINT (396, 92), 1, 14
|
|
END IF
|
|
IF CurrentPAGE < LastPAGE THEN
|
|
PAINT (411, 92), 15, 14
|
|
ELSE
|
|
PAINT (411, 92), 1, 14
|
|
END IF
|
|
ShowMOUSE
|
|
RETURN
|
|
|
|
PutHELP:
|
|
DEF SEG = VARSEG(OtherBOX(0))
|
|
FileNAME$ = "Sol3HP" + LTRIM$(RTRIM$(STR$(CurrentPAGE))) + ".BSV"
|
|
BLOAD FileNAME$, VARPTR(OtherBOX(0))
|
|
DEF SEG
|
|
HideMOUSE
|
|
PUT (194, 80), OtherBOX, PSET
|
|
ShowMOUSE
|
|
GOSUB DoARROWS
|
|
RETURN
|
|
|
|
END SUB
|
|
|
|
SUB Sol3MENU (InOUT)
|
|
SHARED LB, RB, MouseX, MouseY, Menu, Deck1, Deck2, Deck3
|
|
STATIC MenuX, MenuXX, Ix, Iy, Item, Count
|
|
|
|
IF InOUT = 0 THEN GOSUB PutMENU: EXIT SUB
|
|
|
|
'**************************** MENU OPEN SECTION ****************************
|
|
|
|
SELECT CASE Menu
|
|
CASE 3 'Game menu open
|
|
IF MouseX < 10 OR MouseX > 110 THEN GOSUB CloseMENU: EXIT SUB
|
|
SELECT CASE MouseY
|
|
CASE IS < 20
|
|
GOSUB CloseMENU
|
|
CASE 20 TO 37
|
|
IF MouseX < 12 OR MouseX > 52 THEN GOSUB CloseMENU
|
|
CASE 42 TO 56
|
|
IF Item <> 1 THEN
|
|
IF Item THEN GOSUB PutITEM
|
|
Ix = 16: Iy = 42
|
|
GOSUB GetITEM
|
|
Item = 1
|
|
END IF
|
|
IF LB THEN
|
|
GOSUB CloseMENU
|
|
Sol3DEAL
|
|
ClearMOUSE
|
|
END IF
|
|
CASE 57 TO 71
|
|
IF Item <> 2 THEN
|
|
IF Item THEN GOSUB PutITEM
|
|
Ix = 16: Iy = 57
|
|
GOSUB GetITEM
|
|
Item = 2
|
|
END IF
|
|
IF LB THEN
|
|
GOSUB CloseMENU
|
|
Sol3UNDO
|
|
ClearMOUSE
|
|
END IF
|
|
CASE 72 TO 86
|
|
IF Item <> 3 THEN
|
|
IF Item THEN GOSUB PutITEM
|
|
Ix = 16: Iy = 72
|
|
GOSUB GetITEM
|
|
Item = 3
|
|
END IF
|
|
IF LB THEN
|
|
GOSUB CloseMENU
|
|
DEF SEG = VARSEG(OtherBOX(0))
|
|
BLOAD "sol3hp17.bsv", VARPTR(OtherBOX(0))
|
|
DEF SEG
|
|
GET (194, 80)-(446, 203), GetBOX
|
|
PUT (194, 80), OtherBOX, PSET
|
|
IF Vegas = 1 THEN PUT (246, 137), Chek, PSET
|
|
IF Vegas = 0 THEN PUT (246, 155), Chek, PSET
|
|
IF Money = 1 THEN PUT (246, 173), Chek, PSET
|
|
|
|
DO
|
|
MouseSTATUS LB, RB, MouseX, MouseY
|
|
SELECT CASE MouseY
|
|
CASE 86 TO 99 'close options menu
|
|
IF (MouseX > 422 AND MouseX < 438) AND LB THEN
|
|
HideMOUSE
|
|
GET (423, 86)-(437, 99), Buttons(500)
|
|
PUT (423, 86), Buttons(400), PSET
|
|
ShowMOUSE
|
|
Interval .1
|
|
HideMOUSE
|
|
PUT (423, 86), Buttons(500), PSET
|
|
ShowMOUSE
|
|
ClearMOUSE
|
|
EXIT DO
|
|
END IF
|
|
CASE 136 TO 145 'select Vegas type scoring
|
|
IF (MouseX > 243 AND MouseX < 260) AND LB THEN
|
|
HideMOUSE
|
|
IF Vegas = 1 THEN
|
|
Vegas = 0: Score = 0
|
|
PUT (246, 155), Chek, PSET
|
|
LINE (245, 137)-(258, 144), 15, BF
|
|
LINE (563, 18)-(639, 37), 14, BF
|
|
IF Money THEN
|
|
LINE (245, 173)-(258, 180), 15, BF
|
|
Money = 0
|
|
END IF
|
|
ELSE
|
|
PUT (246, 137), Chek, PSET
|
|
LINE (245, 155)-(258, 162), 15, BF
|
|
Vegas = 1: Score = Tally
|
|
END IF
|
|
ShowMOUSE
|
|
ClearMOUSE
|
|
NewDEAL = 1
|
|
END IF
|
|
CASE 154 TO 163 'select no scoring (continuous play)
|
|
IF (MouseX > 243 AND MouseX < 260) AND LB THEN
|
|
HideMOUSE
|
|
IF Vegas = 1 THEN
|
|
LINE (563, 18)-(639, 37), 14, BF
|
|
LINE (246, 137)-(258, 144), 15, BF
|
|
Vegas = 0: Score = 0
|
|
PUT (246, 155), Chek, PSET
|
|
IF Money = 1 THEN
|
|
LINE (246, 173)-(258, 180), 15, BF
|
|
Money = 0
|
|
END IF
|
|
ELSE
|
|
PUT (246, 137), Chek, PSET
|
|
LINE (245, 155)-(258, 162), 15, BF
|
|
Vegas = 1: Score = Tally
|
|
END IF
|
|
ShowMOUSE
|
|
ClearMOUSE
|
|
NewDEAL = 1
|
|
END IF
|
|
CASE 172 TO 181 'money card
|
|
IF (MouseX > 243 AND MouseX < 260) AND LB THEN
|
|
HideMOUSE
|
|
IF Money = 1 THEN
|
|
LINE (245, 173)-(258, 180), 15, BF
|
|
Money = 0
|
|
ELSE
|
|
PUT (246, 173), Chek, PSET
|
|
Money = 1
|
|
IF Vegas = 0 THEN
|
|
PUT (246, 137), Chek, PSET
|
|
LINE (245, 155)-(258, 162), 15, BF
|
|
Vegas = 1: Score = Tally
|
|
END IF
|
|
END IF
|
|
ShowMOUSE
|
|
ClearMOUSE
|
|
NewDEAL = 1
|
|
END IF
|
|
END SELECT
|
|
PauseMOUSE LB, RB, MouseX, MouseY
|
|
LOOP
|
|
OPEN "sol3opts.dat" FOR OUTPUT AS #1
|
|
WRITE #1, Vegas, Money
|
|
CLOSE #1
|
|
HideMOUSE
|
|
PUT (194, 80), GetBOX, PSET
|
|
ShowMOUSE
|
|
IF NewDEAL THEN
|
|
Score = 0
|
|
HideMOUSE
|
|
Sol3DEAL
|
|
IF Vegas THEN SetSCORE
|
|
ShowMOUSE
|
|
ClearMOUSE
|
|
EXIT SUB
|
|
END IF
|
|
ClearMOUSE
|
|
END IF
|
|
CASE 92 TO 106
|
|
IF Item <> 4 THEN
|
|
IF Item THEN GOSUB PutITEM
|
|
Ix = 16: Iy = 92
|
|
GOSUB GetITEM
|
|
Item = 4
|
|
END IF
|
|
IF LB THEN
|
|
GOSUB CloseMENU
|
|
SYSTEM
|
|
END IF
|
|
CASE IS > 106
|
|
GOSUB CloseMENU
|
|
CASE ELSE
|
|
END SELECT
|
|
EXIT SUB
|
|
CASE 4 'Help menu open
|
|
IF MouseX < 63 OR MouseX > 163 THEN GOSUB CloseMENU: EXIT SUB
|
|
SELECT CASE MouseY
|
|
CASE IS < 20
|
|
GOSUB CloseMENU
|
|
CASE 20 TO 37
|
|
IF MouseX < 63 OR MouseX > 103 THEN GOSUB CloseMENU
|
|
CASE 42 TO 56
|
|
IF Item <> 1 THEN
|
|
IF Item THEN GOSUB PutITEM
|
|
Ix = 66: Iy = 42
|
|
GOSUB GetITEM
|
|
Item = 1
|
|
END IF
|
|
IF LB THEN
|
|
GOSUB CloseMENU
|
|
Sol3HELP 1
|
|
ClearMOUSE
|
|
END IF
|
|
CASE 57 TO 71
|
|
IF Item <> 2 THEN
|
|
IF Item THEN GOSUB PutITEM
|
|
Ix = 66: Iy = 57
|
|
GOSUB GetITEM
|
|
Item = 2
|
|
END IF
|
|
IF LB THEN
|
|
GOSUB CloseMENU
|
|
Sol3HELP 2
|
|
ClearMOUSE
|
|
END IF
|
|
CASE 72 TO 86
|
|
IF Item <> 3 THEN
|
|
IF Item THEN GOSUB PutITEM
|
|
Ix = 66: Iy = 72
|
|
GOSUB GetITEM
|
|
Item = 3
|
|
END IF
|
|
IF LB THEN
|
|
GOSUB CloseMENU
|
|
Sol3HELP 3
|
|
ClearMOUSE
|
|
END IF
|
|
CASE 92 TO 106
|
|
IF Item <> 4 THEN
|
|
IF Item THEN GOSUB PutITEM
|
|
Ix = 66: Iy = 92
|
|
GOSUB GetITEM
|
|
Item = 4
|
|
END IF
|
|
IF LB THEN
|
|
GOSUB CloseMENU
|
|
Sol3HELP 4
|
|
ClearMOUSE
|
|
END IF
|
|
CASE IS > 106
|
|
GOSUB CloseMENU
|
|
CASE ELSE
|
|
END SELECT
|
|
EXIT SUB
|
|
END SELECT
|
|
|
|
'*************************** MENU CLOSED SECTION ****************************
|
|
|
|
SELECT CASE MouseX
|
|
CASE IS < 12
|
|
IF Menu THEN GOSUB PutMENU
|
|
CASE 12 TO 52
|
|
IF Menu <> 1 THEN '-------------------- Game selected
|
|
HideMOUSE
|
|
IF Menu THEN GOSUB PutMENU
|
|
MenuX = 12
|
|
GOSUB GetMENU
|
|
LINE (12, 20)-(52, 36), 15, B
|
|
LINE (12, 36)-(52, 36), 0
|
|
LINE (52, 20)-(52, 36), 0
|
|
PUT (20, 24), MenuGFX(200), PSET
|
|
ShowMOUSE
|
|
Menu = 1
|
|
END IF
|
|
IF Menu = 1 AND LB THEN '-------------- Game opens
|
|
HideMOUSE
|
|
LINE (12, 20)-(52, 36), 14, BF
|
|
LINE (12, 20)-(52, 36), 15, B
|
|
LINE (12, 20)-(12, 36), 0
|
|
LINE (12, 20)-(52, 20), 0
|
|
PUT (21, 24), MenuGFX, PSET
|
|
GET (12, 37)-(112, 110), GetBOX
|
|
MenuXX = 12
|
|
DEF SEG = VARSEG(OtherBOX(0))
|
|
BLOAD "sol3men2.bsv", VARPTR(OtherBOX(0))
|
|
DEF SEG
|
|
PUT (12, 37), OtherBOX, PSET
|
|
Menu = 3
|
|
ShowMOUSE
|
|
END IF
|
|
CASE 53 TO 62
|
|
IF Menu THEN GOSUB PutMENU
|
|
CASE 63 TO 103
|
|
IF Menu <> 2 THEN '------------------ Help selected
|
|
HideMOUSE
|
|
IF Menu THEN GOSUB PutMENU
|
|
MenuX = 63
|
|
GOSUB GetMENU
|
|
LINE (63, 20)-(103, 36), 15, B
|
|
LINE (63, 36)-(103, 36), 0
|
|
LINE (103, 20)-(103, 36), 0
|
|
PUT (73, 24), MenuGFX(300), PSET
|
|
ShowMOUSE
|
|
Menu = 2
|
|
END IF
|
|
IF Menu = 2 AND LB THEN '-------------- Help opens
|
|
HideMOUSE
|
|
LINE (63, 20)-(103, 36), 14, BF
|
|
LINE (63, 20)-(103, 36), 15, B
|
|
LINE (63, 20)-(63, 36), 0
|
|
LINE (63, 20)-(103, 20), 0
|
|
PUT (74, 24), MenuGFX(100), PSET
|
|
GET (63, 37)-(163, 110), GetBOX
|
|
DEF SEG = VARSEG(OtherBOX(0))
|
|
BLOAD "sol3men3.bsv", VARPTR(OtherBOX(0))
|
|
DEF SEG
|
|
PUT (63, 37), OtherBOX, PSET
|
|
MenuXX = 63: Menu = 4
|
|
ShowMOUSE
|
|
END IF
|
|
END SELECT
|
|
|
|
EXIT SUB
|
|
|
|
GetITEM:
|
|
HideMOUSE
|
|
GET (Ix, Iy)-(Ix + 92, Iy + 15), ItemBOX
|
|
PUT (Ix, Iy), ItemBOX, PRESET
|
|
ShowMOUSE
|
|
RETURN
|
|
|
|
PutITEM:
|
|
HideMOUSE
|
|
IF ItemBOX(1) THEN PUT (Ix, Iy), ItemBOX, PSET
|
|
ShowMOUSE
|
|
Item = 0
|
|
RETURN
|
|
|
|
GetMENU:
|
|
HideMOUSE
|
|
GET (MenuX, 20)-(MenuX + 40, 36), MenuBOX
|
|
ShowMOUSE
|
|
RETURN
|
|
|
|
PutMENU:
|
|
HideMOUSE
|
|
PUT (MenuX, 20), MenuBOX, PSET
|
|
ShowMOUSE
|
|
Menu = 0
|
|
RETURN
|
|
|
|
CloseMENU:
|
|
HideMOUSE
|
|
PUT (MenuXX, 37), GetBOX, PSET
|
|
PUT (MenuX, 20), MenuBOX, PSET
|
|
ShowMOUSE
|
|
Menu = 0: Item = 0
|
|
RETURN
|
|
'LINE (16, 42)-(108, 56), 4, B
|
|
'LINE (16, 57)-(108, 71), 4, B
|
|
'LINE (16, 72)-(108, 86), 4, B
|
|
'LINE (16, 92)-(108, 106), 4, B
|
|
|
|
END SUB
|
|
|
|
SUB Sol3UNDO
|
|
SHARED Deck1, Deck2, Deck3, Deck4, LastDECK
|
|
|
|
HideMOUSE
|
|
IF Deck4 > 0 THEN
|
|
IF LastDECK THEN
|
|
LastSUIT = TurnUPs(Deck4).Suit
|
|
LastVALUE = TurnUPs(Deck4).Value
|
|
SELECT CASE LastDECK
|
|
CASE 1
|
|
Deck1 = Deck1 + 1
|
|
Decks(1, Deck1).Suit = LastSUIT
|
|
Decks(1, Deck1).Value = LastVALUE
|
|
PUT (5, 43), CardBACK, PSET
|
|
CASE 2
|
|
Deck2 = Deck2 + 1
|
|
Decks(2, Deck2).Suit = LastSUIT
|
|
Decks(2, Deck2).Value = LastVALUE
|
|
PUT (83, 43), CardBACK, PSET
|
|
CASE 3
|
|
Deck3 = Deck3 + 1
|
|
Decks(3, Deck3).Suit = LastSUIT
|
|
Decks(3, Deck3).Value = LastVALUE
|
|
PUT (161, 43), CardBACK, PSET
|
|
END SELECT
|
|
Deck4 = Deck4 - 1
|
|
LastSUIT = TurnUPs(Deck4).Suit
|
|
LastVALUE = TurnUPs(Deck4).Value
|
|
IF Deck4 = 0 THEN
|
|
LINE (239, 43)-(313, 152), 11, BF
|
|
ELSE
|
|
CardNUM = (LastSUIT - 1) * 13 + LastVALUE
|
|
PutCARD 239, 43, CardNUM
|
|
END IF
|
|
END IF
|
|
END IF
|
|
LastDECK = 0
|
|
ShowMOUSE
|
|
|
|
END SUB
|
|
|
|
SUB ABSOLUTE_MOUSE_EMU (AX%, BX%, CX%, DX%)
|
|
SELECT CASE AX%
|
|
CASE 0
|
|
AX% = -1
|
|
CASE 1
|
|
_MOUSESHOW
|
|
CASE 2
|
|
_MOUSEHIDE
|
|
CASE 3
|
|
WHILE _MOUSEINPUT
|
|
WEND
|
|
BX% = -_MOUSEBUTTON(1) - _MOUSEBUTTON(2) * 2 - _MOUSEBUTTON(3) * 4
|
|
CX% = _MOUSEX
|
|
DX% = _MOUSEY
|
|
CASE 4
|
|
_MOUSEMOVE CX%, DX% 'Not currently supported in QB64 GL
|
|
END SELECT
|
|
END SUB
|