12-24-2023, 05:25 AM
Quote:when in doubt hit ESC.
Otherwise enjoy.
Required Resource files:
Paw's Patrol.7z (Size: 8.52 MB / Downloads: 49)
Code: (Select All)
'Paw Patrol matching\memory game
'8/27/2021
'UniKorn ProDucKions
'inital test release V1b(eta)
'9/2/2021:Release-002
'To Be Finished;
'Game Mode 2-Pup to Badge matching
'High Score addition;
'À-Name Entry and Hi-lite
'Add and exit button to Options Screen and High Scores(just hit ESC for now)
TYPE Card_Data
Id AS _BYTE
X1 AS INTEGER
Y1 AS INTEGER
X2 AS INTEGER
Y2 AS INTEGER
END TYPE
TYPE Game_Data
GameType AS _BYTE 'Mode 1(P+P,B+B) or Mode 2(P+B)
BGMVol AS _BYTE 'Music volume
SFXVol AS _BYTE 'Sound volume
Status AS _BYTE 'MainMenu or GameMode
time AS INTEGER 'number of seconds in game
Match AS INTEGER 'number of matches made in game
Level AS SINGLE '"difficulty" of game 1-12cards, 2-24cards,3-48cards,4-70cards
Quit AS SINGLE 'player quits current game
END TYPE
TYPE Game_Board
Id AS _BYTE 'what card is here
Flipped AS _BYTE 'is card flipped?(displayed)
Matched AS _BYTE 'is the card still here?
X AS _BYTE
Y AS _BYTE
END TYPE
'------------------------Constants-------------------------
CONST TRUE = -1, FALSE = NOT TRUE
CONST MainMenu = 1, Options = 2, Help = 3, GameMode = 4, HighScores = 5
CONST Mode_1 = 1, Mode_2 = 2
CONST Level_1 = 1, Level_2 = 1.5, Level_3 = 2, Level_4 = 2.5
CONST LoadedMusic = 3
CONST LoadedSounds = 1
'----------------------------------------------------------
'----------------------Tile Data---------------------------
Card_data: '10 tiles
DATA 32,165,190,323: 'sky
DATA 207,341,365,499: 'chase
DATA 31,517,189,675: 'everest
DATA 383,343,541,501: 'marshal
DATA 30,868,188,1026: 'rubble
DATA 32,340,190,498: 'marshal badge
DATA 30,692,188,850: 'chase badge
DATA 206,693,364,851: 'rubble badge
DATA 206,869,364,1027: 'sky badge
DATA 208,166,366,324: 'everest badge
'perhaps more tiles would be nice?
Board_Size:
DATA 2,3,5,6
DATA 3,5,7,9
'----------------------------------------------------------
'---------------------Array and Globals--------------------
DIM SHARED Layer(16) AS LONG, BGM(5) AS LONG, G AS Game_Data, T&, M&
DIM SHARED FFX(6) AS LONG, Cards(16) AS Card_Data, SFX(5) AS LONG
DIM SHARED Board(96) AS Game_Board, BoardX(4) AS _BYTE, BoardY(4) AS _BYTE
'----------------------------------------------------------
'------------------------Timers----------------------------
T& = _FREETIMER
ON TIMER(T&, .5) BackGroundMusic 'control the background music
M& = _FREETIMER
ON TIMER(M&, 1) CountTime 'keeps track of time during gameplay
'----------------------------------------------------------
SCREEN _NEWIMAGE(800, 600, 32): RANDOMIZE TIMER
_SCREENMOVE 10, 10
G.Status = MainMenu
G.BGMVol = 45
G.SFXVol = 45
MFI_Loader "PawsV1b.mfi"
_PUTIMAGE , Splash&, _DISPLAY 'erase `Loading...` as that is done
SetVolumes 'adjust volume levels
_DELAY 5 'leave the pups up for a few seconds.
Fade_Out _DISPLAY
CLS
'--------------------------GFX setup stuff------------------------
_SETALPHA 48, , Layer(4)
_CLEARCOLOR _RGB32(0), Layer(3)
_CLEARCOLOR _RGB32(0), Layer(4)
_CLEARCOLOR _RGB32(0), Layer(11)
_CLEARCOLOR _RGB32(0), Layer(12)
_CLEARCOLOR _RGB32(0), Layer(14)
_PRINTMODE _KEEPBACKGROUND , Layer(1)
_PRINTMODE _KEEPBACKGROUND , Layer(8)
_PRINTMODE _KEEPBACKGROUND , Layer(9)
_DEST Layer(8)
COLOR _RGB32(100, 235, 250) 'menu options color
_DEST Layer(9)
COLOR _RGB32(100, 235, 250) 'High Score color
_DEST Layer(0)
_FONT FFX(0), Layer(8)
_FONT FFX(0), Layer(1)
_FONT FFX(2), Layer(9)
'-----------------------------------------------------------------
'-----------------------------Load Data---------------------------
FOR i%% = 1 TO 10
READ Cards(i%%).X1, Cards(i%%).Y1, Cards(i%%).X2, Cards(i%%).Y2
NEXT i%%
FOR i%% = 1 TO 4
READ BoardY(i%%)
NEXT i%%
FOR i%% = 1 TO 4
READ BoardX(i%%)
NEXT i%%
'-----------------------------------------------------------------
Build_Screens MainMenu
_SOURCE Layer(7) 'click check layer
_DEST Layer(1)
COLOR _RGB32(255, 255, 0) 'mouse over menu options highlight color
_DEST Layer(0)
Create_ClickMap MainMenu
_DEST Layer(1)
Fade_In Layer(8)
G.Level = Level_1
TIMER(M&) ON
DO
Nul = _MOUSEINPUT
_PUTIMAGE , Layer(8), Layer(1) 'prep the menu layer to screen(erases old screen cycle)
IF _MOUSEBUTTON(1) THEN 'lets see where the user clicked
Opt%% = Mouse_Over
ButtonDown%% = TRUE
Clicked%% = TRUE
ELSE
ButtonDown%% = FALSE
END IF
'check over game options with click layer
SELECT CASE Mouse_Over
CASE 1 ' Game mode 1, Portrat+Portrat
_PRINTSTRING (400 - 64, 200), "Game 1", Layer(1)
CASE 2 ' Game Mode 2, Portrat+Badge
_PRINTSTRING (400 - 64, 250), "Game 2", Layer(1)
CASE 3 ' Help
_PRINTSTRING (400 - 56, 300), " Help", Layer(1)
CASE 4 ' High Scores(most matches in a row? Board completion time?)
_PRINTSTRING (400 - 100, 350), "High Scores", Layer(1)
CASE 5 ' Options (Sound levels, High Score Reset)
_PRINTSTRING (400 - 64, 400), "Options", Layer(1)
CASE 6 ' Quit the game(Tis a sad day indeed!)
_PRINTSTRING (400 - 48, 450), " Quit", Layer(1)
END SELECT
_PUTIMAGE , Layer(1), Layer(0)
_LIMIT 60
IF Clicked%% AND ButtonDown%% = FALSE THEN 'user clicked something lets see what.
SELECT CASE Opt%%
CASE 1
G.Level = Level_1
G.Status = GameMode
DO
Game_Mode1
LOOP UNTIL G.Level = 3 OR G.Quit
IF G.Level = 3 THEN 'victory screen
Run_Victory
END IF
Create_ClickMap MainMenu
G.Status = MainMenu
CASE 2
CASE 3 'Help screen
Fade_Out Layer(0)
Build_Screens Help
Build_Screens MainMenu
Fade_In Layer(8)
CASE 4 'High Scores list
Fade_Out Layer(0)
Build_Screens HighScores
Build_Screens MainMenu
Fade_In Layer(8)
CASE 5 'Options Menu
Fade_Out Layer(0)
Build_Screens Options 'Build Options
Create_ClickMap Options
Fade_In Layer(8)
Options_Menu
Fade_Out Layer(0)
Build_Screens MainMenu 'rebuild MainMenu
Create_ClickMap MainMenu
Fade_In Layer(8)
CASE 6 'ok, lets quit
QuitFlag%% = TRUE
CASE ELSE 'null click, invalid option
Opt%% = 0
END SELECT
Clicked%% = FALSE
END IF
DO: Nul = _MOUSEINPUT: LOOP WHILE _MOUSEINPUT 'clear the mouse buffer
IF INKEY$ = CHR$(27) THEN QuitFlag%% = TRUE
' BackGroundMusic 'deal with the menus background music || Handled with Timer for now
'debugging information area
' LINE (600, 500)-STEP(160, 99), _RGB32(0), BF
' _PRINTSTRING (600, 500), STR$(LastPlay!), Layer(1)
' _PRINTSTRING (600, 524), STR$(Clicked%%), Layer(1)
' _PRINTSTRING (600, 548), STR$(ButtonDown%%), Layer(1)
' _PRINTSTRING (600, 572), STR$(Opt%%), Layer(1)
LOOP UNTIL QuitFlag%%
'Fade_Out _DISPLAY
'SND_FadeOut
'shut down audio
IF _SNDPLAYING(SFX(1)) THEN _SNDSTOP (SFX(1))
IF _SNDPLAYING(SFX(2)) THEN _SNDSTOP (SFX(2))
IF _SNDPLAYING(SFX(3)) THEN _SNDSTOP (SFX(3))
TIMER(M&) OFF
_FONT 16
COLOR _RGB32(255)
'C%% = (800 - (740 - 14)) \ 2
'_PUTIMAGE (C%%, 0), Layer(2), _DISPLAY, (14, 11)-(740, 149) 'Game Menu Title
SUB Create_ClickMap (Opt%%)
_DEST Layer(7)
CLS
SELECT CASE Opt%%
CASE MainMenu
LINE (328, 196)-STEP(127, 31), _RGB32(255, 255, 1), BF
LINE (328, 246)-STEP(127, 31), _RGB32(255, 255, 2), BF
LINE (336, 300)-STEP(111, 31), _RGB32(255, 255, 3), BF
LINE (292, 350)-STEP(199, 31), _RGB32(255, 255, 4), BF
LINE (328, 400)-STEP(127, 31), _RGB32(255, 255, 5), BF
LINE (350, 446)-STEP(95, 31), _RGB32(255, 255, 6), BF
CASE Options
LINE (255, 240)-STEP(16 * 16, 32), _RGB32(255, 255, 1), BF
LINE (255, 290)-STEP(16 * 16, 32), _RGB32(255, 255, 2), BF
LINE (252, 350)-STEP(287, 31), _RGB32(255, 255, 3), BF
LINE (348, 446)-STEP(87, 31), _RGB32(255, 255, 4), BF
CASE Help
CASE GameMode
'the actual game mode is unimportant, just the number of cards to layout.
Offset% = 175 / G.Level
Scaled% = 157 / G.Level
FOR y%% = 0 TO BoardY(G.Level * 2 - 1)
FOR x%% = 0 TO BoardX(G.Level * 2 - 1)
C%% = C%% + 1
LINE (50 + x%% * Offset%, 75 + y%% * Offset%)-STEP(Scaled%, Scaled%), _RGB32(64, 64, C%%), BF
NEXT x%%, y%%
END SELECT
_DEST Layer(7)
END SUB
FUNCTION Mouse_Over~%% ()
Result~%% = 0 'just in case?
Result~%% = _BLUE32(POINT(_MOUSEX, _MOUSEY)) 'get our blue value for option under mouse
Mouse_Over = Result~%%
END FUNCTION
SUB Build_Screens (Opt%%)
ClearLayer Layer(8)
SELECT CASE Opt%%
CASE MainMenu
Cx% = (800 - 464) \ 2 'Center the image on screen
Cy% = (600 - 396) \ 2
_PUTIMAGE (Cx%, Cy%), Layer(4), Layer(8) 'Title Screen Logo background
_PUTIMAGE (0, 64), Layer(3), Layer(8)
_PRINTSTRING (400 - 64, 200), "Game 1", Layer(8)
_PRINTSTRING (400 - 64, 250), "Game 2", Layer(8)
_PRINTSTRING (400 - 56, 300), " Help", Layer(8)
_PRINTSTRING (400 - 100, 350), "High Scores", Layer(8)
_PRINTSTRING (400 - 64, 400), "Options", Layer(8)
_PRINTSTRING (400 - 48, 450), " Quit", Layer(8)
CASE Options
_SETALPHA 96, , Layer(3) 'fade the image
_CLEARCOLOR _RGB32(0), Layer(3) 'restore clear color
Cx% = (800 - 464) \ 2 'Center the image on screen
Cy% = (600 - 396) \ 2
_PUTIMAGE (Cx%, Cy%), Layer(4), Layer(8) 'Title Screen Logo background
_PUTIMAGE (0, 64), Layer(3), Layer(8)
_SETALPHA 255, , Layer(3) 'restore opacity
_CLEARCOLOR _RGB32(0), Layer(3) 'restore clear color
_PRINTSTRING (400 - 120, 200), "Volume Level", Layer(8)
_PRINTSTRING (100, 250), "Music ", Layer(8)
_PRINTSTRING (100, 300), "Sounds", Layer(8)
_PRINTSTRING (400 - 144, 350), "Reset High Scores", Layer(8)
_PRINTSTRING (400 - 40, 450), "Exit", Layer(8)
CASE Help
ClearLayer Layer(9)
_PUTIMAGE , Layer(4), Layer(9)
_PRINTSTRING (16, 32), "In game mode one(1) the goal is to match", Layer(9)
_PRINTSTRING (16, 64), "Pup to Pup and Badge to Badge. Beat all 4", Layer(9)
_PRINTSTRING (16, 96), "levels quickly for high scores!", Layer(9)
_PRINTSTRING (16, 144), "In game mode two(2) the goal is to match", Layer(9)
_PRINTSTRING (16, 176), "Pup to badge. Make as many matches as", Layer(9)
_PRINTSTRING (16, 208), "possible in 120 seconds for high scores!", Layer(9)
_PRINTSTRING (16, 256), "Make matches by clicking on the back of", Layer(9)
_PRINTSTRING (16, 288), "the cards to reveal a pup or badge image.", Layer(9)
_PRINTSTRING (16, 320), "Depending on game mode they matched by", Layer(9)
_PRINTSTRING (16, 352), "Pup to Pup\Badge to Badge, or", Layer(9)
_PRINTSTRING (16, 384), "in game mode 2 Pup to Badge.", Layer(9)
_KEYCLEAR
Fade_In Layer(9)
DO
_PUTIMAGE , Layer(9), Layer(0)
_LIMIT 30
LOOP UNTIL INKEY$ <> ""
Fade_Out Layer(0)
_KEYCLEAR
CASE HighScores
ClearLayer Layer(9)
_PUTIMAGE , Layer(4), Layer(9)
_PUTIMAGE (100, 0), Layer(11), Layer(9)
_PRINTSTRING (168, 160), "Names", Layer(9)
_PRINTSTRING (520, 160), "Times", Layer(9)
_PRINTSTRING (168, 365), "Names", Layer(9)
_PRINTSTRING (520, 365), "Matches", Layer(9)
IF _FILEEXISTS("Paws.HSL") THEN
N$ = SPACE$(26)
T$ = SPACE$(5)
OPEN "Paws.HSL" FOR BINARY AS #1
'Game time high scores (time to finish matches)
GET #1, , Count%%
FOR i%% = 1 TO Count%%
GET #1, , N$
GET #1, , T$
_PRINTSTRING (168, 192 + 24 * i%%), N$, Layer(9)
_PRINTSTRING (520, 192 + 24 * i%%), T$, Layer(9)
NEXT i%%
'Matches under timer (matches made in 120 sec
GET #1, , Count%%
FOR i%% = 1 TO Count%%
GET #1, , N$
GET #1, , T$
_PRINTSTRING (168, 397 + 24 * i%%), N$, Layer(9)
_PRINTSTRING (520, 397 + 24 * i%%), T$, Layer(9)
NEXT i%%
ELSE
_PRINTSTRING (168, 192 + 24 * i%%), "No game yet", Layer(9)
_PRINTSTRING (168, 397 + 24 * i%%), "No game yet", Layer(9)
END IF
CLOSE #1
_KEYCLEAR
Fade_In Layer(9)
DO
_PUTIMAGE , Layer(9), Layer(0)
_LIMIT 30
LOOP UNTIL INKEY$ <> ""
Fade_Out Layer(0)
_KEYCLEAR
CASE GameMode
END SELECT
END SUB
SUB Options_Menu
DO
Nul = _MOUSEINPUT
_PUTIMAGE , Layer(8), Layer(1) 'prep the menu layer to screen(erases old screen cycle)
_DEST Layer(1)
BGMV = G.BGMVol / 100: SFXV = G.SFXVol / 100
LINE (255, 240)-STEP(16 * 16, 32), _RGB32(0 + INT(255 * BGMV), 255 - INT(255 * BGMV), 0), BF
LINE (255, 290)-STEP(16 * 16, 32), _RGB32(0 + INT(255 * SFXV), 255 - INT(255 * SFXV), 0), BF
LINE (255 + (256 * BGMV), 236)-STEP(1, 40), _RGB32(224, 224, 224), B
LINE (255 + (256 * SFXV), 286)-STEP(1, 40), _RGB32(224, 224, 224), B
_DEST Layer(0)
IF _MOUSEBUTTON(1) THEN 'lets see where the user clicked
Opt%% = Mouse_Over
ButtonDown%% = TRUE
Clicked%% = TRUE
ELSE
ButtonDown%% = FALSE
END IF
'check over game options with click layer
SELECT CASE Mouse_Over
CASE 1 'Music Vol controller
_PRINTSTRING (100, 250), "Music ", Layer(1)
CASE 2 ' Sounds Vol Controller
_PRINTSTRING (100, 300), "Sounds", Layer(1)
CASE 3 ' Reset High Scores List
_PRINTSTRING (400 - 144, 350), "Reset High Scores", Layer(1)
CASE 4 ' Exit Options
_PRINTSTRING (400 - 40, 450), "Exit", Layer(1)
END SELECT
_PUTIMAGE , Layer(1), Layer(0)
_LIMIT 60
IF (Clicked%% AND ButtonDown%% = FALSE) AND Opt%% > 2 THEN 'user clicked something lets see what.
SELECT CASE Opt%%
CASE 3 'Reset High Scores
IF _FILEEXISTS("Paws.HSL") THEN KILL "Paws.HSL" 'erase the highscore file
CASE 4 'Exit
ExitFlag%% = TRUE
CASE ELSE 'null click, invalid option
Opt%% = 0
END SELECT
Clicked%% = FALSE
ELSEIF ButtonDown%% THEN 'the volume controls are button down and slide
SELECT CASE Opt%%
CASE 1 'music
G.BGMVol = INT((_MOUSEX - 255) / 256 * 100)
CASE 2 'sounds
G.SFXVol = INT((_MOUSEX - 255) / 256 * 100)
END SELECT
ELSEIF Clicked%% THEN 'once released change volume levels
Clicked%% = FALSE
SetVolumes
END IF
DO: Nul = _MOUSEINPUT: LOOP WHILE _MOUSEINPUT 'clear the mouse buffer
IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE
' BackGroundMusic 'deal with the menus background music || Handled with Timer for now
LOOP UNTIL ExitFlag%%
END SUB
SUB BackGroundMusic
STATIC LastPlay&
IF LastPlay& = 0 THEN _SNDPLAY BGM(1) 'game just started
IF _SNDPLAYING(BGM(1)) THEN
'main theme is still playing so nothing to do!
LastPlay& = TIMER '86399
IF LastPlay& > 86350 THEN LastPlay& = 0 'make the midnight jump (what are little kids doing up?)
'-----------------------------Looping Music Section----------------------------------------
ELSEIF G.Status = MainMenu THEN 'user is in the menus
'================================Menu Music Area===========================================
IF _SNDPLAYING(BGM(2)) THEN 'the instramental is playing
LastPlay& = TIMER '86399
IF LastPlay& > 86350 THEN LastPlay& = 0 'make the midnight jump (what are little kids doing up?)
ELSE
IF TIMER > LastPlay& + 20 AND TIMER < 86350 THEN _SNDPLAY BGM(2)
END IF
'==========================================================================================
ELSEIF G.Status = GameMode THEN 'player is in game
'================================Game Music Area===========================================
IF _SNDPLAYING(BGM(3)) THEN 'the instramental is playing
LastPlay& = TIMER '86399
IF LastPlay& > 86250 THEN LastPlay& = 0 'make the midnight jump (what are little kids doing up?)
ELSE
IF TIMER > LastPlay& + 10 AND TIMER < 86250 THEN _SNDPLAY BGM(3)
END IF
'==========================================================================================
END IF
'-------------------------------------------------------------------------------------------
END SUB
SUB SetVolumes
FOR i%% = 1 TO LoadedMusic
_SNDVOL BGM(i%%), G.BGMVol / 100
NEXT i%%
FOR i%% = 1 TO LoadedSounds 'start at 1 so if 0 sounds loaded nothing is affected
_SNDVOL SFX(i%%), G.SFXVol / 100
NEXT i%%
END SUB
SUB Display_Card (X%, Y%, id%%, Scale!)
'Scale options 1,1.5,2,2.5(Full,1\2,1\4,1\8[these values for refernce only, not correct])
'full-12 cards, 1.5- 24 cards, 2-48 cards, 2.5- 96 cards!
IF id%% THEN
_PUTIMAGE (X%, Y%)-STEP(157 / Scale!, 157 / Scale!), Layer(2), Layer(1), (Cards(id%%).X1, Cards(id%%).Y1)-(Cards(id%%).X2, Cards(id%%).Y2)
ELSE 'card 0 is back side
_PUTIMAGE (X%, Y%)-STEP(157 / Scale!, 157 / Scale!), Layer(2), Layer(1), (384, 166)-STEP(159, 159)
END IF
END SUB
SUB Game_Mode1
DIM card(1) AS _BYTE 'what 2 cards are flipped
CardsLeft%% = (BoardX(G.Level * 2 - 1) + 1) * (BoardY(G.Level * 2 - 1) + 1) 'how many cards to match
Create_ClickMap GameMode 'set the click space
Setup_Cards G.Level 'ready the cards for matching
_DEST Layer(12)
DO
nul% = _MOUSEINPUT
IF _MOUSEBUTTON(1) THEN 'lets see where the user clicked
Opt%% = Mouse_Over
ButtonDown%% = TRUE
Clicked%% = TRUE
ELSE
ButtonDown%% = FALSE
END IF
IF NOT ButtonDown%% AND Clicked%% THEN
IF Opt%% THEN 'dont allow 0 click area(black area)
IF Board(Opt%%).Flipped = FALSE THEN
Board(Opt%%).Flipped = TRUE
Clicked%% = FALSE
card(flipped%%) = Opt%% 'watch which cards are flipped
flipped%% = flipped%% + 1
END IF
END IF
END IF
tmp%% = Mouse_Over
'-------------------------screen update-----------------------
ClearLayer Layer(1)
_PRINTSTRING (5, 5), "Time :", Layer(1)
_PRINTSTRING (5, 34), "Matches:", Layer(1)
Display_Game_Board_II
Display_Time_Elapsed
Display_Matches_Made
_PUTIMAGE , Layer(1), Layer(0)
_PUTIMAGE , Layer(12), Layer(0)
'-------------------------------------------------------------
IF flipped%% = 2 THEN
flipped%% = 0 'reset our flipped card count
IF Board(card(0)).Id = Board(card(1)).Id THEN ' we have a match!
Board(card(0)).Matched = TRUE
Board(card(1)).Matched = TRUE
CardsLeft%% = CardsLeft%% - 2
G.Match = G.Match + 1
Card_Match_Animation card()
ELSE 'no match
Board(card(0)).Flipped = FALSE
Board(card(1)).Flipped = FALSE
_DELAY .5
END IF
END IF
_LIMIT 60
DO: Nul = _MOUSEINPUT: LOOP WHILE _MOUSEINPUT 'clear the mouse buffer
IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE: G.Quit = TRUE
IF CardsLeft%% = 0 THEN 'player wins this level!
G.Level = G.Level + .5
ExitFlag%% = TRUE
END IF
LOOP UNTIL ExitFlag%%
END SUB
SUB Setup_Cards (opt%%)
FOR i%% = 0 TO 96 'erase card data
Board(i%%).Id = 0
Board(i%%).Flipped = FALSE
Board(i%%).Matched = FALSE
NEXT i%%
SELECT CASE G.Level
CASE Level_1 '12 cards
'not enough cards so just load the first 6 cards to match(pups and 1 badge{marshal's})
FOR i%% = 1 TO 12 STEP 2
J%% = J%% + 1
Board(i%%).Id = J%%
Board(i%% + 1).Id = Board(i%%).Id
NEXT i%%
cc%% = 12 'Card Count for the scramble
CASE Level_2 '24 cards
'add the 10 base cards then repeat 2
FOR i%% = 1 TO 24 STEP 2
J%% = J%% + 1
Board(i%%).Id = J%%
Board(i%% + 1).Id = Board(i%%).Id
IF J%% = 10 THEN J%% = 0 'start over
NEXT i%%
cc%% = 24 'Card Count for the scramble
CASE Level_3 '48 cards
'add the 10 base cards then repeat 2
FOR i%% = 1 TO 48 STEP 2
J%% = J%% + 1
Board(i%%).Id = J%%
Board(i%% + 1).Id = Board(i%%).Id
IF J%% = 10 THEN J%% = 0 'start over
NEXT i%%
cc%% = 48 'Card Count for the scramble
CASE Level_4 '70 cards
'add the 10 base cards then repeat 2
FOR i%% = 1 TO 70 STEP 2
J%% = J%% + 1
Board(i%%).Id = J%%
Board(i%% + 1).Id = Board(i%%).Id
IF J%% = 10 THEN J%% = 0 'start over
NEXT i%%
cc%% = 70 'Card Count for the scramble
END SELECT
'scramble cards
FOR i% = 0 TO 200
SWAP Board(INT(RND * cc%%) + 1), Board(INT(RND * cc%%) + 1)
NEXT i%
END SUB
SUB Display_Game_Board (opt%%)
SELECT CASE opt%%
CASE Level_1 ' 12 full sized cards
FOR y%% = 0 TO 2
FOR x%% = 0 TO 3
C%% = C%% + 1
Board(C%%).X = x%%: Board(C%%).Y = y%%
IF NOT Board(C%%).Matched THEN
IF Board(C%%).Flipped THEN
Display_Card 50 + x%% * 175, 75 + y%% * 175, Board(C%%).Id, 1
ELSE
Display_Card 50 + x%% * 175, 75 + y%% * 175, 0, 1
END IF
END IF
NEXT x%%, y%%
CASE Level_2 '24 half sized cards
FOR y%% = 0 TO 3
FOR x%% = 0 TO 5
C%% = C%% + 1
IF NOT Board(C%%).Matched THEN
IF Board(C%%).Flipped THEN
Display_Card 50 + x%% * 115, 75 + y%% * 115, Board(C%%).Id, 1.5
ELSE
Display_Card 50 + x%% * 115, 75 + y%% * 115, 0, 1.5
END IF
END IF
NEXT x%%, y%%
CASE Level_3
FOR y%% = 0 TO 4
FOR x%% = 0 TO 7
C%% = C%% + 1
IF NOT Board(C%%).Matched THEN
IF Board(C%%).Flipped THEN
Display_Card 50 + x%% * 88, 75 + y%% * 88, Board(C%%).Id, 2
ELSE
Display_Card 50 + x%% * 88, 75 + y%% * 88, 0, 2
END IF
END IF
NEXT x%%, y%%
CASE Level_4
FOR y%% = 0 TO 6
FOR x%% = 0 TO 9
C%% = C%% + 1
IF NOT Board(C%%).Matched THEN
IF Board(C%%).Flipped THEN
Display_Card 50 + x%% * 64, 75 + y%% * 64, Board(C%%).Id, 2
ELSE
Display_Card 50 + x%% * 64, 75 + y%% * 64, 0, 2
END IF
END IF
NEXT x%%, y%%
END SELECT
END SUB
SUB Display_Game_Board_II
Offset% = 175 / G.Level 'card spacing
FOR y%% = 0 TO BoardY(G.Level * 2 - 1)
FOR x%% = 0 TO BoardX(G.Level * 2 - 1)
C%% = C%% + 1
Board(C%%).X = x%%: Board(C%%).Y = y%%
IF NOT Board(C%%).Matched THEN 'if the card is matched do not display
IF Board(C%%).Flipped THEN 'if player has flipped card then display image
Display_Card 50 + x%% * Offset%, 75 + y%% * Offset%, Board(C%%).Id, G.Level
ELSE 'otherwise display back of card
Display_Card 50 + x%% * Offset%, 75 + y%% * Offset%, 0, G.Level
END IF
END IF
NEXT x%%, y%%
END SUB
SUB CountTime
IF G.Status = GameMode THEN 'count time while playing
G.time = G.time + 1
ELSE 'when in menu reset game time
G.time = 0
END IF
END SUB
SUB Display_Time_Elapsed
min$ = LTRIM$(STR$(G.time \ 60))
sec$ = LTRIM$(STR$(G.time MOD 60))
IF LEN(sec$) = 1 THEN sec$ = "0" + sec$
IF G.time \ 60 THEN T$ = min$ + ":" + sec$ ELSE T$ = sec$
_PRINTSTRING (160, 8), T$, Layer(1)
END SUB
SUB Display_Matches_Made
_PRINTSTRING (160, 32), LTRIM$(STR$(G.Match)), Layer(1)
END SUB
SUB Run_Victory
SND_FadeOut
MFI_Loader_victory "Victory.ANI"
END SUB
SUB Card_Match_Animation (c() AS _BYTE)
TIMER(M&) OFF
_DEST Layer(0)
Offset% = 175 / G.Level 'card spacing
'blank out cards
LINE (50 + Board(c(0)).X * Offset%, 75 + Board(c(0)).Y * Offset%)-STEP(157 / G.Level, 157 / G.Level), _RGB32(0), BF
LINE (50 + Board(c(1)).X * Offset%, 75 + Board(c(1)).Y * Offset%)-STEP(157 / G.Level, 157 / G.Level), _RGB32(0), BF
'make a tme copy of the desktop
tmp& = _COPYIMAGE(_DISPLAY)
'----------------------card start points----------------------------
StartX! = 50 + Board(c(0)).X * Offset%
StartY! = 75 + Board(c(0)).Y * Offset%
Start2X! = 50 + Board(c(1)).X * Offset%
Start2Y! = 75 + Board(c(1)).Y * Offset%
'-------------------------------------------------------------------
'----------------------distance to center---------------------------
IF StartX! < 320 THEN Card1X_dist% = 320 - StartX! ELSE Card1X_dist% = -(StartX! - 320)
IF StartY! < 220 THEN Card1Y_dist% = 220 - StartY! ELSE Card1Y_dist% = -(StartY! - 220)
IF Start2X! < 320 THEN Card2X_dist% = 320 - Start2X! ELSE Card2X_dist% = -(Start2X! - 320)
IF Start2Y! < 220 THEN Card2Y_dist% = 220 - Start2Y! ELSE Card2Y_dist% = -(Start2Y! - 220)
'-------------------------------------------------------------------
'------------travel per frame for 60 moves----------------
x1! = Card1X_dist% / 60
y1! = Card1Y_dist% / 60
x2! = Card2X_dist% / 60
y2! = Card2Y_dist% / 60
'---------------------------------------------------------
DO
StartX! = StartX! + x1!
StartY! = StartY! + y1!
Start2X! = Start2X! + x2!
Start2Y! = Start2Y! + y2!
_PUTIMAGE , tmp&, Layer(1)
Display_Card StartX!, StartY!, Board(c(0)).Id, G.Level
Display_Card Start2X!, Start2Y!, Board(c(1)).Id, G.Level
_PUTIMAGE , Layer(1), Layer(0)
IF INKEY$ = CHR$(27) THEN Exitflag%% = TRUE
_LIMIT 48
count% = count% + 1
IF count% = 61 THEN Exitflag%% = TRUE
LOOP UNTIL Exitflag%%
Startx% = INT(StartX!)
Starty% = INT(StartX!) - 48
FOR i! = 1 TO .25 STEP -.05
_PUTIMAGE , tmp&, Layer(1)
c% = c% + 15
Display_Card 5 + Startx% - c%, Starty% - c%, Board(c(0)).Id, i!
_PUTIMAGE , Layer(1), Layer(0)
_LIMIT 30
NEXT i!
_DELAY .75
FOR i! = .25 TO 3.5 STEP .1
_PUTIMAGE , tmp&, Layer(1)
c% = c% - 20
Display_Card Startx% - c%, Starty% - c%, Board(c(0)).Id, i!
_PUTIMAGE (Startx% - c% - 33, Starty% - c% - 33)-STEP(190 / (i! - .05), 183 / (i! - .05)), Layer(14), Layer(1), (0 + 191 * f%%, 0)-STEP(190, 183)
_PUTIMAGE , Layer(1), Layer(0)
_LIMIT 17
f%% = f%% + 1
IF f%% = 30 THEN f%% = 0
NEXT i!
TIMER(M&) ON
END SUB
'$include:'PPMG_GFXRoutines.bas'
SUB MFI_Loader_victory (FN$)
DIM Size(128) AS LONG, FOffset(128) AS LONG
OPEN FN$ FOR BINARY AS #1
GET #1, , c~%% 'retrieve number of files
FOR I~%% = 1 TO c~%%
GET #1, , FOffset(I~%%)
GET #1, , Size(I~%%)
FOffset&(I~%%) = FOffset&(I~%%) + 1
NEXT I~%%
ClearLayer Layer(1)
ClearLayer Layer(0)
_SNDPLAY SFX(1)
DO
fr%% = fr%% + 1
tmp& = LoadGFX(FOffset(fr%%), Size(fr%%))
_PUTIMAGE (100, 192), tmp&, Layer(1)
_PUTIMAGE (135, 16), Layer(13), Layer(1)
_PUTIMAGE , Layer(1), Layer(0)
_LIMIT 16
IF fr%% = 95 THEN Exitflag%% = TRUE
_FREEIMAGE tmp&
LOOP UNTIL Exitflag%%
tmp& = LoadGFX(FOffset(92), Size(92))
_PUTIMAGE (100, 192), tmp&, Layer(1)
_PUTIMAGE (135, 16), Layer(13), Layer(1)
_PUTIMAGE , Layer(1), Layer(0)
_FREEIMAGE tmp&
_DELAY 4
CLOSE #1
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
END SUB
FUNCTION LoadGFX& (Foff&, Size&)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadGFX& = _LOADIMAGE("temp.dat", 32)
END FUNCTION
FUNCTION LoadFFX& (Foff&, Size&, Fize%%, Att$)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadFFX& = _LOADFONT("temp.dat", Fize%%, Att$)
END FUNCTION
FUNCTION LoadSFX& (Foff&, Size&)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadSFX& = _SNDOPEN("temp.dat")
END FUNCTION
SUB LoadData (Foff&, Size&)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
END SUB
SUB MFI_Loader (FN$)
DIM Size(128) AS LONG, FOffset(128) AS LONG
OPEN FN$ FOR BINARY AS #1
GET #1, , c~%% 'retrieve number of files
FOR I~%% = 1 TO c~%%
GET #1, , FOffset(I~%%)
GET #1, , Size(I~%%)
FOffset&(I~%%) = FOffset&(I~%%) + 1
NEXT I~%%
'-----------------------Splash Screen setup-------------------------
_PRINTSTRING (0, 574), "Loading...", _DISPLAY
Splash& = LoadGFX(FOffset(9), Size(9)) 'Splash screen
BGM(1) = LoadSFX(FOffset(1), Size(1))
TIMER(T&) ON 'start the background musics
SetVolumes 'adjust volume levels
DO: _LIMIT 60: LOOP UNTIL _SNDGETPOS(BGM(1)) > 1
Fade_In Splash&
_PUTIMAGE , Splash&, _DISPLAY 'show the splash screen while loading
_PRINTSTRING (0, 574), "Loading..."
'-------------------------------------------------------------------
Layer(0) = _DISPLAY
Layer(1) = _COPYIMAGE(_DISPLAY) 'Mix layer
Layer(7) = _NEWIMAGE(800, 600, 32) 'click map layer
Layer(8) = _NEWIMAGE(800, 600, 32) 'Main Menu\Options Layer
Layer(9) = _NEWIMAGE(800, 600, 32) 'High Score\Help layer
Layer(10) = _NEWIMAGE(800, 600, 32) 'Mouse Over hi-lite layer
Layer(12) = _NEWIMAGE(800, 600, 32) 'debug info
Layer(2) = LoadGFX(FOffset(2), Size(2)) 'Tiles
Layer(3) = LoadGFX(FOffset(3), Size(3)) 'Title
Layer(4) = LoadGFX(FOffset(4), Size(4)) 'BackGround
Layer(5) = LoadGFX(FOffset(5), Size(5)) 'Pups
Layer(6) = LoadGFX(FOffset(6), Size(6)) 'bitmap font
Layer(11) = LoadGFX(FOffset(7), Size(7)) 'high score title
Layer(13) = LoadGFX(FOffset(8), Size(8)) 'Victory screen title
Layer(14) = LoadGFX(FOffset(14), Size(14)) 'Match sparkle animation
BGM(2) = LoadSFX(FOffset(10), Size(10)) 'instramental theme
BGM(3) = LoadSFX(FOffset(11), Size(11)) 'extended instramental
SFX(1) = LoadSFX(FOffset(12), Size(12)) 'victory cheer
FFX(0) = LoadFFX(FOffset(13), Size(13), 36, "BOLD") 'main font
FFX(1) = LoadFFX(FOffset(13), Size(13), 24, "") 'high score font
FFX(2) = LoadFFX(FOffset(13), Size(13), 24, "MONOSPACE") 'help font
CLOSE #1
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
END SUB