'Gapper(1986) Clone
'10\25\2019 Cobalt
'ÃInital Start; Layout, Gapper, Seeker, L1 Grid finished [13:55EDT]
'ÀCorreted 'Catcher' to 'Seeker' as per original game
'10\31\2021
'ÃFixed Seeker movement issue with help from Bplus and Keybone, used ABS as per Bplus
'Àadded startup screen, player initials input,game options
'11\1\2021
'ÃAdded the instructions screens
'Àenabled collision of Seeker and Gapper
'11\11\2021
'ÃFinished all 8 boards
'11\13\2021
'ÃInserted Bplus's code for detecting completed boxes.
'11\14\2021
'ÃIntegrated Bplus's code for detecting completed boxes and filling them.
'ÃAdded score amount to filled boxes
'ÃLevels now end when boxes are full
'ÀScore is now kept
'11\15\2021
'ÃFixed a few minor bugs with help from Bplus
'ÃReplaced each level creation sub with a master so now all levels created with in a single sub, saved ~210 lines
'ÀChanged Seeker speed to use reducing timer to move faster as levels progress.
'11\18\2021
'ÃAdded extra life at 5000 point intervals
'ÀAdded ability to create "Gaps" on board
Start
AS _BYTE 'is level started or not(nothing happens until started) Caught
AS _BYTE 'has the seeker caught the gapper? Gapped
AS _BYTE 'has the player used the gap feature? Gap_time
AS SINGLE 'the time the gap was placed. Gaps last less time at higher levels 'board info
Needed
AS _BYTE 'number of cells needing finished to win level Finished
AS _BYTE 'number of cells currently boxed in
CONST TRUE
= -1, FALSE
= NOT TRUE
, Gapper
= 1, Seeker
= 2 CONST UP
= 1, DOWN
= 2, LEFT
= 3, RIGHT
= 4 CONST Key_Right
= 19712, Key_Left
= 19200, Key_Up
= 18432, Key_Down
= 20480 CONST Key_Space
= 32, Key_Enter
= 13 CONST Cyan
= &HFF10E0E0~&
'_RGB32(0, 170, 170) CONST Magenta
= &HFFC040C0~&
CONST OffWhite
= &HFFC0C0C0~&
CONST Brown
= &HFFB06000~&
CONST Yellow
= &HFFFFFF00~&
CONST Black
= &HFF000000~&
CONST DB_Blue
= &HFF0000FF~&
Level_data:
DATA 104,60,3,3,4,10,9,0,14,626,374 DATA 76,44,4,4,8,12,16,8,18,616,370 DATA 60,36,5,5,10,10,25,12,14,612,374 DATA 48,24,7,6,16,16,42,24,26,600,362 DATA 36,24,7,8,16,16,44,24,26,458,362 DATA 36,24,7,8,16,16,40,168,26,458,362 DATA 36,24,7,8,16,16,44,168,26,600,362 DATA 36,24,7,8,16,16,56,24,26,600,362
Layer
(1) = _NEWIMAGE(640, 440, 32) 'mix layerLayer
(2) = _NEWIMAGE(320, 220, 32) 'Grid LayerLayer
(3) = _NEWIMAGE(640, 440, 32) 'Sprite layerLayer
(4) = _NEWIMAGE(320, 220, 32) 'Info layerLayer
(5) = _NEWIMAGE(640, 440, 32) 'Collision 'Gapper\Catcher' layerLayer
(6) = _NEWIMAGE(640, 440, 32) 'Collision 'Grid' layerLayer
(7) = _NEWIMAGE(640, 440, 32) 'debug layerLayer
(8) = _NEWIMAGE(320, 220, 32) 'Menu layerLayer
(9) = _NEWIMAGE(320, 240, 32) 'instructions layerLayer
(10) = _NEWIMAGE(320, 8, 32) 'title bar layerLayer
(11) = _NEWIMAGE(320, 220, 32) 'point test location layer
Game_INIT
Title_Startup
G.Start = TRUE
IF NOT Collision_Grid
(Gapper
, UP
) THEN G.GD
= UP
G.Start = TRUE
IF NOT Collision_Grid
(Gapper
, DOWN
) THEN G.GD
= DOWN
G.Start = TRUE
IF NOT Collision_Grid
(Gapper
, LEFT
) THEN G.GD
= LEFT
G.Start = TRUE
IF NOT Collision_Grid
(Gapper
, RIGHT
) THEN G.GD
= RIGHT
G.Gapped = TRUE
G.Score = G.Score - 5
Create_Gap
IF G.Start
THEN Move_Gapper
':Move_Seeker IF G.Gapped
THEN Time_Gap
'if there is a gap then check how long its been there
FOR i%%
= 1 TO G.Columns
* G.Rows
IF BoxSurrounded
(i%%
) THEN FinishedBox
(i%%
) = TRUE
IF FinishedBox
(i%%
) THEN FillBox i%%
Game_Data_Update
_PUTIMAGE , Layer
(4), Layer
(1) 'information bar Place_Gapper
Place_Seeker
IF G.Caught
THEN 'seeker caught 'em ClearLayer Layer(5)
Reset_Pos
DrawBoard
G.Lives = G.Lives - 1
IF G.Lives
= -1 THEN ExitFlag%%
= TRUE
' _PRINTSTRING (600, 0), STR$(G.FPS), Layer(7)
ClearLayer Layer(1)
Frames% = Frames% + 1
LINE (G.GX
- 2, G.GY
- 2)-STEP(20, 18), Black
, BF
'place gapper-----
_PUTIMAGE (G.GX
, G.GY
), Layer
(3), Layer
(1), (318, 218)-STEP(15, 13) 'place Gapper shadow
_PUTIMAGE (G.GX
, G.GY
), Layer
(3), Layer
(5), (318, 218)-STEP(15, 13) ' _DEST old&
'place Seeker----
_PUTIMAGE (G.SX
, G.SY
), Layer
(3), Layer
(1), (341, 218)-STEP(14, 11) '-----------------
'Player----
DRAW "c" + STR$(Cyan
) + "drurd8l2dr3u9d2rd5ru5rd5ru5ru2d9r3ul2u8r2dlbl3c" + STR$(Magenta
) + "u3ld3lu3ld3" DRAW "bd7d3ru3rd3ru3bu3br3r4ul4bl9l4dr4" '----------
'Seeker----
DRAW "c" + STR$(Cyan
) + "r3dl3bd10r3ul3br10r3dl3bu10r3ul3c" + STR$(Magenta
) + "bd2brl3dr3bd5l3dr3bl6l3ur3" DRAW "bu5l3ur3d2lr5dl5dr5dl5" '------------
Title_Header
G.Score = 0
G.Lives = 2
G.Level = 1
'Header
'Info area updating ---------------
_PRINTSTRING (7, 192), "Score[ ] Lives[ ] Level[ ]", Layer
(4) '-----------------------------------
CASE 1 TO 8 'draw level 1 grid Master_Level G.Level
CASE ELSE 'after level 8 board is random between 5 and 8 ClearLayer Layer(6)
_PUTIMAGE , Layer
(2), Layer
(6) 'make a copy for the collision layer
Result%% = FALSE
IF POINT(G.SX
+ 8, G.SY
+ 8) <> Black
THEN Result%%
= TRUE
Collision_Seeker = Result%%
FUNCTION Collision_Grid%%
(who%%
, Direction%%
) Result%% = TRUE 'always assume collision
SELECT CASE who%%
'who are we checking collision for? CASE UP
'see if there is grid up from Gappers position Check~&
= POINT(G.GX
+ 8, G.GY
+ 5) CASE DOWN
'see if there is Grid below Gapper Check~&
= POINT(G.GX
+ 8, G.GY
+ 9) CASE LEFT
'check for grid to the left of Gapper Check~&
= POINT(G.GX
+ 6, G.GY
+ 7) CASE RIGHT
'Check for grid to the Right of Gapper Check~&
= POINT(G.GX
+ 10, G.GY
+ 7) CASE UP
'see if there is grid up from Gappers position Check~&
= POINT(G.SX
+ 8, G.SY
+ 5) CASE DOWN
'see if there is Grid below Gapper Check~&
= POINT(G.SX
+ 8, G.SY
+ 9) CASE LEFT
'check for grid to the left of Gapper Check~&
= POINT(G.SX
+ 6, G.SY
+ 7) CASE RIGHT
'Check for grid to the Right of Gapper Check~&
= POINT(G.SX
+ 10, G.SY
+ 7) Blue~%%
= _BLUE32(Check~&
) 'check for Blue, grid is Cyan in color IF Blue~%%
THEN Result%%
= FALSE
'there is grid to move onto, no collision with edge of grid Collision_Grid = Result%%
'_SOURCE Layer(0)
Seeker_Logic
IF NOT Collision_Grid
(Seeker
, UP
) THEN G.SY
= G.SY
- 2 IF NOT Collision_Grid
(Seeker
, DOWN
) THEN G.SY
= G.SY
+ 2 IF NOT Collision_Grid
(Seeker
, LEFT
) THEN G.SX
= G.SX
- 2 IF NOT Collision_Grid
(Seeker
, RIGHT
) THEN G.SX
= G.SX
+ 2 IF Collision_Seeker
THEN G.Caught
= TRUE
IF NOT Collision_Grid
(Gapper
, UP
) THEN G.GY
= G.GY
- 2 IF NOT Collision_Grid
(Gapper
, DOWN
) THEN G.GY
= G.GY
+ 2 IF NOT Collision_Grid
(Gapper
, LEFT
) THEN G.GX
= G.GX
- 2 IF NOT Collision_Grid
(Gapper
, RIGHT
) THEN G.GX
= G.GX
+ 2 Color_Line
DistX% = (G.SX - G.GX) 'find X distance between seeker and gapper
DistY% = (G.SY - G.GY) 'find Y distance between Seeker and Gapper
IF ABS(DistX%
) > ABS(DistY%
) THEN 'if player is farther on the X then Turn_Seeker RIGHT 'try going right to get closer
Turn_Seeker LEFT 'try going left to get closer
ELSE 'player is farther on the Y then Turn_Seeker DOWN 'try going down to get closer
Turn_Seeker UP 'try going up to get closer
SUB Turn_Seeker
(Direction%%
) IF NOT Collision_Grid
(Seeker
, UP
) THEN G.SD
= UP
IF NOT Collision_Grid
(Seeker
, DOWN
) THEN G.SD
= DOWN
IF NOT Collision_Grid
(Seeker
, LEFT
) THEN G.SD
= LEFT
IF NOT Collision_Grid
(Seeker
, RIGHT
) THEN G.SD
= RIGHT
LINE (4 + G.GX \
2, 3 + G.GY \
2)-STEP(0, 0), Magenta
, BF
G.FPS = Frames%
Frames% = 0
Load_Scores
Get_Player
IF Search_For_Player
THEN AddPlayer
'first time this player has played! Display_HighScores
Get_Menu_Selection
Blink%% = TRUE: I$ = ""
LINE (168, 210)-(248, 219), Black
, BF
LINE (168, 210)-(248, 219), Black
, BF
CASE 13 'accept input(if any) ExitFlag%% = TRUE
G.Quit = TRUE
t%% = t%% + 1
IF t%%
= 4 THEN Blink%%
= NOT Blink%%: t%%
= 0 G.Player = I$
New_Game
DrawBoard
Play_game
ExitFlag%% = TRUE
G.Quit = TRUE
Get_Player
Instructions
'ExitFlag%% = TRUE
'G.Quit = TRUE
IF G.Player
= Scores
(i%%
).Nam
THEN COLOR Yellow
'player shows up Yellow COLOR Magenta
'High score if not player shows magenta COLOR OffWhite
'everybody else is off white
ClearLayer Layer(0)
'end of page 1
'end of page 2
ClearLayer Layer(0)
GET #1, , Scores
(i%%
).Nam
IF G.Player
= Scores
(i%%
).Nam
THEN Result%%
= TRUE: i%%
= 11 ELSE Result%%
= FALSE
Search_For_Player = Result%%
IF Count%%
< 10 THEN Count%%
= Count%%
+ 1 PUT #1, 1 + 10 * Count%%
, G.Player
PUT #1, , NULL&
'filler for score PUT #1, , NULL%
'filler for level Load_Scores 'reload score list
G.Start = FALSE
G.Caught = FALSE
G.Finished = 0
ClearLayerTrans Layer(2)
FinishedBox(i%%) = FALSE
FUNCTION BoxSurrounded%%
(boxNumber
AS INTEGER) 'save already tested boxes in shared array BoxesSurrounded() 'Bplus contributed code. 11\12\2021
'some variables changed to use existing, `**` comments are added
IF FinishedBox
(boxNumber
) = 0 THEN '**Is the box completed already? row
= INT((boxNumber
- 1) / G.Columns
) '[cellsPerCpl)] '**which row col
= (boxNumber
- 1) MOD G.Columns
+ 1 '[cellsAcross + 1] '**which column
Good%% = TRUE
FOR I%
= row
* G.CellHeight
TO (row
+ 1) * G.CellHeight
STEP 4 '**No need to check every pixel IF POINT(G.Offx
+ (col
- 1) * G.CellWidth
, G.Offy
+ I%
) <> Magenta
THEN I%
= 9999: Good%%
= FALSE
' False Baox not surrounded IF POINT(G.Offx
+ col
* G.CellWidth
, G.Offy
+ I%
) <> Magenta
THEN I%
= 9999: Good%%
= FALSE
IF Good%%
THEN '**only check other lines if it hasn't failed yet FOR I%
= (col
- 1) * G.CellWidth
TO col
* G.CellWidth
STEP 4 '**No need to check every pixel IF POINT(G.Offx
+ I%
, G.Offy
+ row
* G.CellHeight
) <> Magenta
THEN I%
= 9999: Good%%
= FALSE
' False Baox not surrounded IF POINT(G.Offx
+ I%
, G.Offy
+ (row
+ 1) * G.CellHeight
) <> Magenta
THEN I%
= 9999: Good%%
= FALSE
IF Good%%
THEN BoxSurrounded
= -1: G.Finished
= G.Finished
+ 1: G.Score
= G.Score
+ 50:
PLAY "o3l54eeggee": Check_Score
'all OK BoxSurrounded = -1
' _DELAY .25
row
= INT((boxNumber
- 1) / G.Columns
) col
= (boxNumber
- 1) MOD G.Columns
+ 1 LINE (G.Offx
+ (col
- 1) * G.CellWidth
+ 3, G.Offy
+ row
* G.CellHeight
+ 3)-STEP(G.CellWidth
- 6, G.CellHeight
- 6), OffWhite
, BF
_PRINTSTRING (G.Offx
+ (col
- 1) * G.CellWidth
+ 3 + (INT(G.CellWidth \
2) - 8), G.Offy
+ row
* G.CellHeight
+ 3 + (INT(G.CellHeight \
2) - 8)), "50", Layer
(2)
G.Level = G.Level + 1
speed! = (.05 - (G.Level / 1000) * 5)
IF speed!
<= .015 THEN speed!
= .015 ClearLayerTrans Layer(2)
ClearLayer Layer(5)
ClearLayer Layer(6)
DrawBoard
G.Finished = 0
FinishedBox(i%%) = FALSE
G.Start = FALSE
FOR i%%
= 1 TO Level
'load level data READ G.CellWidth
, G.CellHeight
, G.Rows
, G.Columns
, G.Offx
, G.Offy
, G.Needed
, G.GX
, G.GY
, G.SX
, G.SY
LINE (G.Offx
, G.Offy
+ i%%
* G.CellHeight
)-STEP(G.CellWidth
* G.Columns
, 0), Cyan
'horizontal lines LINE (G.Offx
+ i%%
* G.CellWidth
, G.Offy
)-STEP(0, G.CellHeight
* G.Rows
), Cyan
'vertical lines CASE 5 ' "Â" shaped level LINE (16, 16 + i%%
* 24)-STEP(288, 0), Cyan
'horizontal lines LINE (88 + i%%
* 36, 16)-STEP(0, 168), Cyan
'vertical lines LINE (88, 136 + i%%
* 24)-STEP(144, 0), Cyan
'horizontal lines LINE (16 + i%%
* 36, 16)-STEP(0, 96), Cyan
'vertical lines LINE (268 + i%%
* 36, 16)-STEP(0, 96), Cyan
'vertical lines CASE 6 ' "Å" shaped level LINE (16, 64 + i%%
* 24)-STEP(288, 0), Cyan
'horizontal lines LINE (88 + i%%
* 36, 16)-STEP(0, 168), Cyan
'vertical lines LINE (88 + i%%
* 36, 16)-STEP(0, 168), Cyan
'vertical lines
LINE (88, 16 + i%%
* 24)-STEP(144, 0), Cyan
'horizontal lines LINE (88, 160 + i%%
* 24)-STEP(144, 0), Cyan
'horizontal lines LINE (16 + i%%
* 36, 64)-STEP(0, 72), Cyan
'vertical lines LINE (268 + i%%
* 36, 64)-STEP(0, 72), Cyan
'vertical lines CASE 7 ' "Á" shaped level LINE (16, 88 + i%%
* 24)-STEP(288, 0), Cyan
'horizontal lines LINE (88 + i%%
* 36, 16)-STEP(0, 168), Cyan
'vertical lines LINE (88, 16 + i%%
* 24)-STEP(144, 0), Cyan
'horizontal lines LINE (16 + i%%
* 36, 88)-STEP(0, 96), Cyan
'vertical lines LINE (268 + i%%
* 36, 88)-STEP(0, 96), Cyan
'vertical lines LINE (88, 16 + i%%
* 24)-STEP(144, 0), Cyan
'horizontal lines
IF G.Score
= 0 THEN Current_life
= 0 'reset on new game IF INT(G.Score \
5000) = Current_life
+ 1 THEN 'Bonus Life, only worry about the thousands place to ' avoid issues with non-5000 exact multiples
Current_life = Current_life + 1
G.Lives = G.Lives + 1
IF G.Gapped
THEN 'when a new gap is made get the pos. this sub is called to erase too X% = G.GX + 8 'Xpos of gapper center
Y% = G.GY + 7 'Ypos of gapper center
D% = G.GD 'direction of gap(up\down or left\right)
_DEST Layer
(6) 'draw the gap to the detection layer _DEST Layer
(2) 'also display gap on visual layer (can only gap where you've been so restore to Magenta) 'layer 2 is 320x220 so we must half the x,y points
IF G.Gapped
THEN LINE (.5 * X%
, .5 * Y%
- 3)-STEP(0, 5), Black
ELSE LINE (.5 * X%
, .5 * Y%
- 3)-STEP(0, 5), Magenta
'erase or restore _DEST Layer
(6) 'draw the gap to the detection layer _DEST Layer
(2) 'also display gap on visual layer (can only gap where you've been so restore to Magenta) 'layer 2 is 320x220 so we must half the x,y points
IF G.Gapped
THEN LINE (.5 * X%
- 3, .5 * Y%
- 1)-STEP(5, 1), Black
, BF
ELSE LINE (.5 * X%
- 3, .5 * Y%
- 1)-STEP(5, 1), Magenta
, BF
'erase or restore ' _DEST Layer(0)
' CLS
' _PUTIMAGE , Layer(2), Layer(0)
' G.GY = G.GY + 16
' _PUTIMAGE (G.GX, G.GY), Layer(3), Layer(0), (318, 218)-STEP(15, 13)
' END
IF G.Level
<= 20 THEN Max_Time!
= 500 - (G.Level
* 20) ELSE Max_Time!
= 100 Max_Time! = Max_Time! / 100 'convert to seconds (5 sec to 1 sec)
G.Gapped = FALSE
Create_Gap 'call the SUB again to fill in gap
G.Score = 0
G.Lives = 2
FinishedBox(i%%) = FALSE
ClearLayerTrans Layer(2)
Check_Score 'reset extra lives counter