Author Topic: How to check if a box has been completed? (Read 25313 times)

Cobalt · « **on:** November 12, 2021, 01:25:37 pm »

So thanks to some help, the seeker no longer gets stuck. and I have implemented collision between seeker and gapper.
now anybody have a thought on how I should go about checking for completed boxes?
I thought about using an array and check the status of the lines with point.
something like

Code: QB64: [Select]

 SUB Check_Box
DIM Grid_Check(7, 6) AS _BYTE 'largest board(8) is 8x7(0-7,0-6)
  SELECT CASE G.Level
   CASE 1 '3x3(0-2,0-2)
    'check horizontals
    FOR Iy%% = 0 TO 2
     FOR Ix%% = 0 TO 2 'check top line
      FOR x%% = 0 TO 60 STEP 6 'check 10 points
       IF POINT(4 + x%% + 60 * Ix%%, 10) = Magenta THEN full%% = TRUE ELSE full%% = FALSE: x%% = 66
      NEXT x%%
      IF full%% THEN Grid_Check(Ix%%, Iy%%) = TRUE
     NEXT Ix%%
    NEXT Iy%%
    'check verticals
 END SELECT
END SUB
 

The more I look at that, the more it seems like its not going to work as I intend. I gave some thought to using a UDT with UP,DOWN,LEFT,RIGHT to store the completion status of each box, but didn't like the thought of having so much overlap and double checks going on all the time.

I would really appreciate any input on possible methods to for completed boxes.

progress so far:

Code: QB64: [Select]

'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\12\2021
'Ã
 
TYPE GameData
 Player AS STRING * 4
 Score AS LONG
 Lives AS _BYTE
 Level AS _BYTE
 GX AS INTEGER 'Gapper X location
 GY AS INTEGER 'Gapper Y location
 GD AS _BYTE 'Gapper direction
 SX AS INTEGER
 SY AS INTEGER
 SS AS _BYTE 'Seeker speed
 SD AS _BYTE 'Seeker direction
 Start AS _BYTE 'is level started or not(nothing happens until started)
 FPS AS INTEGER
 Quit AS _BYTE
 Caught AS _BYTE 'has the seeker caught the gapper?
END TYPE
 
TYPE High_Scores
 Nam AS STRING * 4
 Score AS LONG
 Level AS INTEGER
END TYPE
 
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~&
 
SCREEN _NEWIMAGE(640, 440, 32)
DIM SHARED Layer(10) AS LONG, G AS GameData, Frames%
DIM SHARED Scores(10) AS High_Scores
 
Layer(0) = _DISPLAY
Layer(1) = _NEWIMAGE(640, 440, 32) 'mix layer
Layer(2) = _NEWIMAGE(320, 220, 32) 'Grid Layer
Layer(3) = _NEWIMAGE(640, 440, 32) 'Sprite layer
Layer(4) = _NEWIMAGE(320, 220, 32) 'Info layer
Layer(5) = _NEWIMAGE(640, 440, 32) 'Collision 'Gapper\Catcher' layer
Layer(6) = _NEWIMAGE(640, 440, 32) 'Collision 'Grid' layer
Layer(7) = _NEWIMAGE(640, 440, 32) 'debug layer
Layer(8) = _NEWIMAGE(320, 220, 32) 'Menu layer
Layer(9) = _NEWIMAGE(320, 240, 32) 'instructions layer
Layer(10) = _NEWIMAGE(320, 8, 32) 'title bar layer
 
_FONT 8, Layer(4)
_FONT 8, Layer(8)
_FONT 8, Layer(9)
_FONT 8, Layer(10)
_PRINTMODE _KEEPBACKGROUND , Layer(10)
_PRINTMODE _KEEPBACKGROUND , Layer(8)
_PRINTMODE _KEEPBACKGROUND , Layer(9)
_CLEARCOLOR _RGB32(0, 0, 0), Layer(3)
_CLEARCOLOR _RGB32(0, 0, 0), Layer(7)
 
_SCREENMOVE 16, 16
_SOURCE Layer(6)
 
ON TIMER(t1&, 1) FPS
'Title_Startup
'END
Game_INIT
DrawBoard
TIMER(t1&) ON
DO
 IF _KEYDOWN(27) THEN ExitFlag%% = TRUE
 IF _KEYDOWN(Key_Up) THEN
  G.Start = TRUE
  IF NOT Collision_Grid(Gapper, UP) THEN G.GD = UP
 END IF
 IF _KEYDOWN(Key_Down) THEN
  G.Start = TRUE
  IF NOT Collision_Grid(Gapper, DOWN) THEN G.GD = DOWN
 END IF
 IF _KEYDOWN(Key_Left) THEN
  G.Start = TRUE
  IF NOT Collision_Grid(Gapper, LEFT) THEN G.GD = LEFT
 END IF
 IF _KEYDOWN(Key_Right) THEN
  G.Start = TRUE
  IF NOT Collision_Grid(Gapper, RIGHT) THEN G.GD = RIGHT
 END IF
 
 IF G.Start THEN Move_Seeker: Move_Gapper
 
 Game_Data_Update
 _PUTIMAGE (0, 0)-STEP(639, 15), Layer(10), Layer(1)
 _PUTIMAGE , Layer(4), Layer(1)
 _PUTIMAGE , Layer(2), Layer(1)
 Place_Gapper
 Place_Seeker
 IF G.Caught THEN
  ClearLayer Layer(5)
  Reset_Pos
  DrawBoard
  G.Lives = G.Lives - 1
  IF G.Lives = -1 THEN ExitFlag%% = TRUE
 END IF
 _PRINTSTRING (600, 0), STR$(G.FPS), Layer(7)
 _PUTIMAGE , Layer(7), Layer(1)
 _PUTIMAGE , Layer(1), Layer(0)
 _LIMIT 60
 ClearLayer Layer(1)
 Frames% = Frames% + 1
LOOP UNTIL ExitFlag%%
_KEYCLEAR
 
SLEEP
 
SUB Place_Gapper
 old& = _DEST
 _DEST Layer(5)
 LINE (G.GX - 2, G.GY - 2)-STEP(20, 18), Black, BF
 _DEST old&
 '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)
END SUB
 
SUB Place_Seeker
 'place Seeker----
 _PUTIMAGE (G.SX, G.SY), Layer(3), Layer(1), (341, 218)-STEP(14, 11)
 '-----------------
END SUB
 
 
SUB Game_INIT
 _DEST Layer(3)
 'Player----
 DRAW "c" + STR$(Cyan) + "drurd8l2dr3u9d2rd5ru5rd5ru5ru2d9r3ul2u8r2dlbl3c" + STR$(Magenta) + "u3ld3lu3ld3"
 DRAW "bd7d3ru3rd3ru3bu3br3r4ul4bl9l4dr4"
 '----------
 DRAW "br20bu7"
 'Seeker----
 DRAW "c" + STR$(Cyan) + "r3dl3bd10r3ul3br10r3dl3bu10r3ul3c" + STR$(Magenta) + "bd2brl3dr3bd5l3dr3bl6l3ur3"
 DRAW "bu5l3ur3d2lr5dl5dr5dl5"
 '------------
 Title_Header
 _DEST Layer(5)
 LINE (0, 0)-STEP(639, 439), Black, BF
 _DEST Layer(0)
 G.Score = 0
 G.Lives = 2
 G.Level = 1
END SUB
 
SUB Title_Header
 'Header
 _DEST Layer(10)
 LINE (84, 0)-STEP(151, 8), Magenta, BF
 LINE (132, 0)-STEP(52, 8), Cyan, BF
 COLOR Magenta
 _PRINTSTRING (135, 1), "GAPPER"
 COLOR OffWhite
END SUB
 
SUB Game_Data_Update
 'Info area updating ---------------
 _PRINTSTRING (7, 192), "Score[      ]    Lives[ ]    Level[  ]", Layer(4)
 _PRINTSTRING (95 - ((LEN(LTRIM$(STR$(G.Score))) - 1) * 8), 192), LTRIM$(STR$(G.Score)), Layer(4)
 _PRINTSTRING (191, 192), LTRIM$(STR$(G.Lives)), Layer(4)
 _PRINTSTRING (295 - ((LEN(LTRIM$(STR$(G.Level))) - 1) * 8), 192), LTRIM$(STR$(G.Level)), Layer(4)
 '-----------------------------------
END SUB
 
SUB DrawBoard
 _DEST Layer(2)
 SELECT CASE G.Level
  CASE 1 'draw level 1 grid
   Level_1_Board
  CASE 2
   Level_2_Board
  CASE 3
   Level_3_Board
  CASE 4
   Level_4_Board
  CASE 5
   Level_5_Board
  CASE 6
   Level_6_Board
  CASE 7
   Level_7_Board
  CASE 8
   Level_8_Board
  CASE ELSE 'after level 8 board is random between 5 and 8
   SELECT CASE INT(RND * 4) + 5
    CASE 5
     Level_5_Board
    CASE 6
     Level_6_Board
    CASE 7
     Level_7_Board
    CASE 8
     Level_8_Board
   END SELECT
 END SELECT
 _DEST Layer(0)
 ClearLayer Layer(6)
 _PUTIMAGE , Layer(2), Layer(6) 'make a copy for the collision layer
END SUB
 
SUB ClearLayer (L&)
 _DEST L&
 CLS
 _DEST _DISPLAY
END SUB
 
FUNCTION Collision_Seeker%%
 Result%% = FALSE
 _SOURCE Layer(5)
 IF POINT(G.SX, G.SY) <> Black THEN Result%% = TRUE
 IF POINT(G.SX + 8, G.SY) <> Black THEN Result%% = TRUE
 IF POINT(G.SX, G.SY + 8) <> Black THEN Result%% = TRUE
 IF POINT(G.SX + 8, G.SY + 8) <> Black THEN Result%% = TRUE
 IF Result%% THEN LOCATE 1, 1: PRINT POINT(G.SX, G.SY), POINT(G.SX + 8, G.SY), POINT(G.SX, G.SY + 8), POINT(G.SX + 8, G.SY + 8)
 Collision_Seeker = Result%%
 _SOURCE Layer(6)
END FUNCTION
 
FUNCTION Collision_Grid%% (who%%, Direction%%)
 Result%% = TRUE 'always assume collision
 SELECT CASE who%% 'who are we checking collision for?
  CASE Gapper
   SELECT CASE Direction%%
    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)
   END SELECT
  CASE Seeker
   SELECT CASE Direction%%
    CASE UP 'see if there is grid up from Gappers position
     Check~& = POINT(G.SX + 8, G.SY + 5)
     _PRINTSTRING (250, 400), "UP   ", Layer(7)
    CASE DOWN 'see if there is Grid below Gapper
     Check~& = POINT(G.SX + 8, G.SY + 9)
     _PRINTSTRING (250, 400), "DOWN ", Layer(7)
    CASE LEFT 'check for grid to the left of Gapper
     Check~& = POINT(G.SX + 6, G.SY + 7)
     _PRINTSTRING (250, 400), "LEFT ", Layer(7)
    CASE RIGHT 'Check for grid to the Right of Gapper
     Check~& = POINT(G.SX + 10, G.SY + 7)
     _PRINTSTRING (240, 400), "RIGHT", Layer(7)
   END SELECT
 END SELECT
 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)
END FUNCTION
 
 
SUB Move_Seeker
 STATIC Mover%%
 Seeker_Logic
 IF Mover%% < G.SS THEN
  Mover%% = Mover%% + 1 'Slow our seeker down
 ELSE
  Mover%% = 0
  SELECT CASE G.SD
   CASE UP
    IF NOT Collision_Grid(Seeker, UP) THEN G.SY = G.SY - 2
   CASE DOWN
    IF NOT Collision_Grid(Seeker, DOWN) THEN G.SY = G.SY + 2
   CASE LEFT
    IF NOT Collision_Grid(Seeker, LEFT) THEN G.SX = G.SX - 2
   CASE RIGHT
    IF NOT Collision_Grid(Seeker, RIGHT) THEN G.SX = G.SX + 2
  END SELECT
 END IF
 IF Collision_Seeker THEN G.Caught = TRUE
 _PRINTSTRING (10, 400), STR$(Mover%%) + STR$(G.SD) + STR$(G.SX - G.GX) + STR$(G.SY - G.GY) + " " + STR$(G.SY) + "      ", Layer(7)
END SUB
 
SUB Move_Gapper
 SELECT CASE G.GD
  CASE UP
   IF NOT Collision_Grid(Gapper, UP) THEN G.GY = G.GY - 2
  CASE DOWN
   IF NOT Collision_Grid(Gapper, DOWN) THEN G.GY = G.GY + 2
  CASE LEFT
   IF NOT Collision_Grid(Gapper, LEFT) THEN G.GX = G.GX - 2
  CASE RIGHT
   IF NOT Collision_Grid(Gapper, RIGHT) THEN G.GX = G.GX + 2
 END SELECT
 Color_Line
END SUB
 
SUB Seeker_Logic
 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
  IF DistX% < 0 THEN
   Turn_Seeker RIGHT 'try going right to get closer
  ELSE
   Turn_Seeker LEFT 'try going left to get closer
  END IF
 ELSE 'player is farther on the Y then
  IF DistY% < 0 THEN
   Turn_Seeker DOWN 'try going down to get closer
  ELSE
   Turn_Seeker UP 'try going up to get closer
  END IF
 END IF
END SUB
 
SUB Turn_Seeker (Direction%%)
 SELECT CASE Direction%%
  CASE UP
   IF NOT Collision_Grid(Seeker, UP) THEN G.SD = UP
  CASE DOWN
   IF NOT Collision_Grid(Seeker, DOWN) THEN G.SD = DOWN
  CASE LEFT
   IF NOT Collision_Grid(Seeker, LEFT) THEN G.SD = LEFT
  CASE RIGHT
   IF NOT Collision_Grid(Seeker, RIGHT) THEN G.SD = RIGHT
 END SELECT
END SUB
 
SUB Color_Line
 _DEST Layer(2)
 LINE (4 + G.GX \ 2, 3 + G.GY \ 2)-STEP(0, 0), Magenta, BF
 _DEST Layer(0)
END SUB
 
SUB FPS
 G.FPS = Frames%
 Frames% = 0
END SUB
 
SUB Title_Startup
 _DEST Layer(8)
 LINE (84, 0)-STEP(151, 8), Brown, BF
 LINE (132, 0)-STEP(52, 8), Cyan, BF
 COLOR Brown
 _PRINTSTRING (135, 1), "GAPPER"
 LINE (0, 140)-STEP(639, 8), Brown, BF
 COLOR Black
 _PRINTSTRING (0, 141), "Score:"
 _PRINTSTRING (220, 141), "Level:"
 _PRINTSTRING (100 - (LEN(LTRIM$(STR$(G.Score))) * 8), 141), STR$(G.Score) + "."
 _PRINTSTRING (284 - (LEN(LTRIM$(STR$(G.Level))) * 8), 141), STR$(G.Level)
 
 COLOR Yellow
 _PRINTSTRING (100, 160), "P: Play a game."
 _PRINTSTRING (100, 170), "Q: Quit"
 _PRINTSTRING (100, 180), "N: New Player"
 _PRINTSTRING (100, 190), "I: Instuctions"
 COLOR Magenta
 _PRINTSTRING (0, 210), "Enter your initials:"
 COLOR OffWhite
 
 Get_Player
 IF Search_For_Player THEN AddPlayer 'first time this player has played!
 Display_HighScores
 IF NOT G.Quit THEN Get_Menu_Selection
END SUB
 
SUB Get_Player
 Blink%% = TRUE: I$ = ""
 DO 'Initials input Loop
  KBD& = _KEYHIT
  SELECT CASE KBD&
   CASE 8 'delete
    IF LEN(I$) THEN I$ = LEFT$(I$, LEN(I$) - 1)
    LINE (168, 210)-(248, 219), Black, BF
   CASE 32 TO 122 'characters
    IF LEN(I$) < 3 THEN I$ = I$ + CHR$(KBD&)
    LINE (168, 210)-(248, 219), Black, BF
   CASE 13 'accept input(if any)
    IF RTRIM$(I$) <> "" THEN ExitFlag%% = TRUE
   CASE 27
    ExitFlag%% = TRUE
    G.Quit = TRUE
  END SELECT
  COLOR OffWhite
  _PRINTSTRING (168, 210), I$
  IF Blink%% THEN COLOR Black ELSE COLOR OffWhite
  _PRINTSTRING (168 + LEN(I$) * 8, 210), "_"
  _PUTIMAGE , Layer(8), _DISPLAY
  _LIMIT 30
  t%% = t%% + 1
  IF t%% = 4 THEN Blink%% = NOT Blink%%: t%% = 0
 LOOP UNTIL ExitFlag%%
 G.Player = I$
END SUB
 
SUB Get_Menu_Selection
 LINE (0, 210)-STEP(200, 9), Black, BF
 _PRINTSTRING (0, 210), "Please enter selection:  "
 DO
  KBD& = _KEYHIT
  SELECT CASE KBD&
   CASE ASC("p") OR ASC("P")
   CASE ASC("q") OR ASC("Q")
    ExitFlag%% = TRUE
    G.Quit = TRUE
   CASE ASC("n") OR ASC("N")
   CASE ASC("i") OR ASC("I")
    Instructions
   CASE 27
    ExitFlag%% = TRUE
    G.Quit = TRUE
  END SELECT
  _PUTIMAGE , Layer(8), _DISPLAY
 LOOP UNTIL ExitFlag%%
END SUB
 
SUB Display_HighScores
 _DEST Layer(8)
 IF LTRIM$(RTRIM$(Scores(1).Nam)) <> "" THEN
  COLOR Magenta
  _PRINTSTRING (0, 24), "High scores:"
  FOR i%% = 1 TO 10
   IF G.Player = Scores(i%%).Nam THEN
    COLOR Yellow 'player shows up Yellow
   ELSEIF i%% = 1 THEN
    COLOR Magenta 'High score if not player shows magenta
   ELSE
    COLOR OffWhite 'everybody else is off white
   END IF
  NEXT i%%
 END IF
END SUB
 
SUB Instructions
 ClearLayer Layer(0)
 _DEST Layer(9)
 LINE (84, 0)-STEP(151, 8), Brown, BF
 LINE (132, 0)-STEP(52, 8), Cyan, BF
 COLOR Brown
 _PRINTSTRING (135, 1), "GAPPER"
 COLOR OffWhite
 _PRINTSTRING (84, 10), "OBJECT"
 _PRINTSTRING (1, 20), "To color all the blue lines"
 _PRINTSTRING (1, 30), "res by moving your man GAPPER"
 _PRINTSTRING (1, 40), "with the arrow keys.  At the"
 _PRINTSTRING (1, 50), "same time, you myst avoid"
 _PRINTSTRING (1, 60), "the SEEKER."
 
 _PRINTSTRING (84, 80), "POINTS"
 _PRINTSTRING (1, 90), "Fifty points are awarded for"
 _PRINTSTRING (1, 100), "each square that you surround"
 _PRINTSTRING (1, 110), "in red.  100 points are given"
 _PRINTSTRING (1, 120), "when you encircle the extra"
 _PRINTSTRING (1, 130), "point box while it is on. Each"
 _PRINTSTRING (1, 140), "gap costs 5 points."
 
 _PRINTSTRING (84, 150), "GAPPING"
 _PRINTSTRING (1, 160), "You can create a temporary"
 _PRINTSTRING (1, 170), "gap in the lines by pressing"
 _PRINTSTRING (1, 180), "the SPACE bar or RETURN.  The"
 _PRINTSTRING (1, 190), "word ON appears as long as the"
 _PRINTSTRING (1, 200), "gap is active.  Neither you nor"
 _PRINTSTRING (1, 210), "the seeker can cross the gap."
 
 _PRINTSTRING (0, 230), "Press a key..."
 _PUTIMAGE , Layer(9), _DISPLAY
 _DELAY .5
 _KEYCLEAR
 'end of page 1
 DO: _LIMIT 24: LOOP WHILE INKEY$ = ""
 CLS
 LINE (84, 0)-STEP(151, 8), Brown, BF
 LINE (132, 0)-STEP(52, 8), Cyan, BF
 COLOR Brown
 _PRINTSTRING (135, 1), "GAPPER"
 COLOR OffWhite
 _PRINTSTRING (84, 10), "LEVELS"
 _PRINTSTRING (1, 20), "The level increases each time"
 _PRINTSTRING (1, 30), "you complete a screen.  The"
 _PRINTSTRING (1, 40), "seeker gets faster, the gap"
 _PRINTSTRING (1, 50), "time shorter and there will"
 _PRINTSTRING (1, 60), "be more boxes."
 
 _PRINTSTRING (84, 80), "LIVES"
 _PRINTSTRING (1, 90), "You start out with 2 extra"
 _PRINTSTRING (1, 100), "men.  One more will be given"
 _PRINTSTRING (1, 110), "for each 5000 points."
 
 _PRINTSTRING (84, 130), "START"
 _PRINTSTRING (1, 140), "When the grid appears, you"
 _PRINTSTRING (1, 150), "Will be in the top left and"
 _PRINTSTRING (1, 160), "the seeker at the low right."
 _PRINTSTRING (1, 170), "Press a key to begin each new"
 _PRINTSTRING (1, 180), "screen."
 
 _PRINTSTRING (0, 230), "Press a key..."
 'end of page 2
 _PUTIMAGE , Layer(9), _DISPLAY
 _DELAY .5
 _KEYCLEAR
 DO: _LIMIT 24: LOOP WHILE INKEY$ = ""
 ClearLayer Layer(0)
END SUB
 
SUB Load_Scores
 OPEN "Gapper.HSL" FOR BINARY AS #1
 GET #1, , Count%%
 FOR i%% = 1 TO Count%%
  GET #1, , Scores(i%%).Nam
  GET #1, , Scores(i%%)
  GET #1, , Scores(i%%)
 NEXT i%%
 CLOSE #1
END SUB
 
FUNCTION Search_For_Player
 FOR i%% = 1 TO 10
  IF G.Player = Scores(i%%).Nam THEN Result%% = TRUE: i%% = 11 ELSE Result%% = FALSE
 NEXT i%%
 Search_For_Player = Result%%
END FUNCTION
 
SUB AddPlayer
 OPEN "Gapper.HSL" FOR BINARY AS #1
 GET #1, , Count%%
 IF Count%% < 10 THEN Count%% = Count%% + 1
 PUT #1, 1, Count%%
 PUT #1, 1 + 10 * Count%%, G.Player
 PUT #1, , NULL& 'filler for score
 PUT #1, , NULL% 'filler for level
 CLOSE #1
 Load_Scores 'reload score list
END SUB
 
SUB Reset_Pos
 PLAY "o1l32aacceegg"
 _DELAY .25
 G.Start = FALSE
 G.Caught = FALSE
 SELECT CASE G.Level
  CASE 1
   'Level 1 Start Pos.------
   G.GX = 0: G.GY = 14 'Gapper
   G.SX = 626: G.SY = 374 'Seeker
   '------------------------
 END SELECT
END SUB
 
SUB check_box
 DIM Grid_Check(7, 6) AS _BYTE 'largest board(8) is 8x7(0-7,0-6)
 IF G.Start THEN
  SELECT CASE G.Level
   CASE 1 '3x3(0-2,0-2)
    'check horizontals
    FOR Iy%% = 0 TO 2
     FOR Ix%% = 0 TO 2 'check top line
      FOR x%% = 0 TO 60 STEP 6 'check 10 points
       IF POINT(4 + x%% + 60 * Ix%%, 10) = Magenta THEN full%% = TRUE ELSE full%% = FALSE: x%% = 66
      NEXT x%%
      IF full%% THEN Grid_Check(Ix%%, Iy%%) = TRUE
     NEXT Ix%%
    NEXT Iy%%
    'check verticals
    FOR Ix%% = 0 TO 2
     FOR Iy%% = 0 TO 2
      FOR x%% = 0 TO 60 STEP 6 'check 10 points
       IF POINT(4 + x%% + 60 * Ix%%, 10) = Magenta THEN full%% = TRUE ELSE full%% = FALSE: x%% = 66
      NEXT x%%
      IF full%% THEN Grid_Check(Ix%%, Iy%%) = TRUE
 
     NEXT Iy%%
    NEXT Ix%%
  END SELECT
 ELSE
  FOR Ix%% = 0 TO 7
   FOR Iy%% = 0 TO 6
    Grid_Check(Ix%%, Iy%%) = FALSE
  NEXT Iy%%, Ix%%
 END IF
END SUB
 
SUB Level_1_Board
 FOR I%% = 0 TO 3
  LINE (4, 10 + I%% * 60)-STEP(311, 0), Cyan 'horizontal lines
  LINE (4 + I%% * 104, 10)-STEP(0, 180), Cyan 'vertical lines
 NEXT I%%
 G.SS = 2 'set seeker speed 1\4th player speed
 G.Start = FALSE
 'Level 1 Start Pos.------
 G.GX = 0: G.GY = 14 'Gapper
 G.SX = 626: G.SY = 374 'Seeker
 '------------------------
END SUB
 
SUB Level_2_Board
 FOR I%% = 0 TO 4
  LINE (8, 12 + I%% * 44)-STEP(304, 0), Cyan 'horizontal lines
  LINE (8 + I%% * 76, 12)-STEP(0, 176), Cyan 'vertical lines
 NEXT I%%
 G.SS = 1 'set seeker speed 1\4th player speed
 G.Start = FALSE
 'Level 2 Start Pos.------
 G.GX = 8: G.GY = 18 'Gapper
 G.SX = 616: G.SY = 370 'Seeker
 '------------------------
END SUB
 
SUB Level_3_Board
 FOR I%% = 0 TO 5
  LINE (10, 10 + I%% * 36)-STEP(300, 0), Cyan 'horizontal lines
  LINE (10 + I%% * 60, 10)-STEP(0, 180), Cyan 'vertical lines
 NEXT I%%
 G.SS = 1 'set seeker speed 1\4th player speed
 G.Start = FALSE
 'Level 5 Start Pos.------
 G.GX = 12: G.GY = 14 'Gapper
 G.SX = 612: G.SY = 374 'Seeker
 '------------------------
END SUB
 
SUB Level_4_Board
 FOR I%% = 0 TO 6
  LINE (16, 16 + I%% * 24)-STEP(288, 0), Cyan 'horizontal lines
  LINE (16 + I%% * 48, 16)-STEP(0, 168), Cyan 'vertical lines
 NEXT I%%
 LINE (16, 16 + I%% * 24)-STEP(288, 0), Cyan 'horizontal lines
 G.SS = 1 'set seeker speed 1\4th player speed
 G.Start = FALSE
 'Level 4 Start Pos.------
 G.GX = 24: G.GY = 26 'Gapper
 G.SX = 600: G.SY = 362 'Seeker
 '------------------------
END SUB
 
SUB Level_5_Board
 FOR I%% = 0 TO 4
  LINE (16, 16 + I%% * 24)-STEP(288, 0), Cyan 'horizontal lines
  LINE (88 + I%% * 36, 16)-STEP(0, 168), Cyan 'vertical lines
 NEXT I%%
 FOR I%% = 0 TO 1
  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
 NEXT I%%
 
 G.SS = 1 'set seeker speed = player speed
 G.Start = FALSE
 'Level 5 Start Pos.------
 G.GX = 24: G.GY = 26 'Gapper
 G.SX = 458: G.SY = 362 'Seeker
 '------------------------
END SUB
 
SUB Level_6_Board
 FOR I%% = 0 TO 3
  LINE (16, 64 + I%% * 24)-STEP(288, 0), Cyan 'horizontal lines
  LINE (88 + I%% * 36, 16)-STEP(0, 168), Cyan 'vertical lines
 NEXT I%%
 LINE (88 + I%% * 36, 16)-STEP(0, 168), Cyan 'vertical lines
 
 FOR I%% = 0 TO 1
  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
 NEXT I%%
 
 G.SS = 1 'set seeker speed = player speed
 G.Start = FALSE
 'Level 6 Start Pos.------
 G.GX = 168: G.GY = 26 'Gapper
 G.SX = 458: G.SY = 362 'Seeker
 '------------------------
END SUB
 
SUB Level_7_Board
 FOR I%% = 0 TO 4
  LINE (16, 88 + I%% * 24)-STEP(288, 0), Cyan 'horizontal lines
  LINE (88 + I%% * 36, 16)-STEP(0, 168), Cyan 'vertical lines
 NEXT I%%
 FOR I%% = 0 TO 1
  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
 NEXT I%%
 LINE (88, 16 + I%% * 24)-STEP(144, 0), Cyan 'horizontal lines
 
 G.SS = 1 'set seeker speed = player speed
 G.Start = FALSE
 'Level 5 Start Pos.------
 G.GX = 168: G.GY = 26 'Gapper
 G.SX = 600: G.SY = 362 'Seeker
 '------------------------
END SUB
 
SUB Level_8_Board
 FOR I%% = 0 TO 7
  LINE (16, 16 + I%% * 24)-STEP(288, 0), Cyan 'horizontal lines
  LINE (16 + I%% * 36, 16)-STEP(0, 168), Cyan 'vertical lines
 NEXT I%%
 LINE (16 + I%% * 36, 16)-STEP(0, 168), Cyan 'vertical lines
 G.SS = 1 'set seeker speed 1\4th player speed
 G.Start = FALSE
 'Level 8 Start Pos.------
 G.GX = 24: G.GY = 26 'Gapper
 G.SX = 600: G.SY = 362 'Seeker
 '------------------------
END SUB

bplus · « **Reply #1 on:** November 12, 2021, 04:17:55 pm »

Follow the directions in the Title bar to test the demo I have for finding surrounded boxes. This requires not just the function BoxSurrounded%(boxNumber) which returns 0 or -1, but an integrated environment to make the function work easily.

Once a box is determined to be surrounded, it never needs to be checked again by checking all Points around it.

Code: QB64: [Select]

_Title "Box Surrounded Test" ' b+ 2021-11-12
 
Screen _NewImage(800, 600, 32) '
_Delay .25
_ScreenMove _Middle
Dim Shared cellsDown, cellsAcross, nCells, cellWidth, cellHeight, surroundColor As _Unsigned Long
cellsAcross = 5
cellsDown = 3
nCells = cellsAcross * cellsDown
cellWidth = Int(_Width / cellsAcross - 1) 'subtract 1 to get borders around all cells on screen
cellHeight = Int(_Height / cellsDown - 1)
surroundColor = _RGB32(255, 0, 255) ' purple as I recall
Dim Shared BoxesSurrounded(1 To nCells) As Integer
_Title "Box Surrounded Test: To demo, we need to start with a grid... zzz = Sleep, press any to continue."
Sleep
'drawGrid
For i = 0 To _Width Step cellWidth
    Line (i, 0)-(i, cellsDown * cellHeight)
Next
For i = 0 To _Height Step cellHeight
    Line (0, i)-(cellsAcross * cellWidth, i)
Next
'label cells (boxes) with id number
i = 1
For r = 1 To cellsDown
    For c = 1 To cellsAcross
        _PrintString ((c - 1) * cellWidth + 2, (r - 1) * cellHeight + 2), _Trim$(Str$(i))
        i = i + 1
    Next
Next
_Title "Demo BoxSurrounded, next we need to randomly surround 3 boxes... zzz"
Sleep
Randomize Timer
For i = 1 To 3
    tryAgain:
    B = Int(Rnd * nCells) + 1
    If BoxesSurrounded(B) = 0 Then surroundBox B: BoxesSurrounded(B) = -1 Else GoTo tryAgain
Next
_Title "OK now find the boxes surrounded with the BoxSurrounded%() Function and light them up!... zzz"
Sleep
 
'OK now if a box is surrounded then fill it in
For i = 1 To nCells
    If BoxSurrounded%(i) Then fillBox i
Next
_Title "End of Demo, thanks for playing... zzz"
Sleep
 
Sub fillBox (boxNumber)
    row = Int((boxNumber - 1) / cellsAcross)
    col = (boxNumber - 1) Mod cellsAcross + 1
    Line ((col - 1) * cellWidth + 3, row * cellHeight + 3)-Step(cellWidth - 6, cellHeight - 6), &HFFFFFF00, BF
End Sub
 
Sub surroundBox (boxNumber)
    row = Int((boxNumber - 1) / cellsAcross)
    col = (boxNumber - 1) Mod cellsAcross + 1
    Line ((col - 1) * cellWidth, row * cellHeight)-Step(cellWidth, cellHeight), surroundColor, B
End Sub
 
Function BoxSurrounded% (boxNumber As Integer) 'save already tested boxes in shared array BoxesSurrounded()
    If BoxesSurrounded(boxNumber) = 0 Then
        row = Int((boxNumber - 1) / cellsPerCpl)
        col = (boxNumber - 1) Mod cellsAcross + 1
        For i = (row - 1) * cellHeight To row * cellHeight
            If Point((col - 1) * cellWidth, i) <> surroundColor Then Exit Function ' False Baox not surrounded
            If Point(col * cellWidth, i) <> surroundColor Then Exit Function
        Next
        For i = (col - 1) * cellWidth To col * cellWidth
            If Point(i, (row - 1) * cellHeight) <> surroundColor Then Exit Function ' False Baox not surrounded
            If Point(i, row * cellHeight) <> surroundColor Then Exit Function
        Next
        BoxSurrounded% = -1 'all OK
    Else
        BoxSurrounded = -1
    End If
End Function
 
 
 

EDIT: Sorry, as soon as I posted this I realized a couple of variable names might be confusing and so I substituted better choices, I hope.

bplus · « **Reply #2 on:** November 12, 2021, 04:37:53 pm »

Easy to change levels on this code:

Code: QB64: [Select]

_Title "Box Surrounded Test" ' b+ 2021-11-12
 
Screen _NewImage(800, 600, 32) '
_Delay .25
_ScreenMove _Middle
Dim Shared cellsDown, cellsAcross, nCells, cellWidth, cellHeight, surroundColor As _Unsigned Long
 
 
' piece of cake to modify this code for different levels just change these 2 lines!!!
cellsAcross = 10
cellsDown = 8
' ====================================================================================
 
' ...
' ...
 

Cobalt · « **Reply #3 on:** November 13, 2021, 02:33:44 pm »

in this line

row = INT((boxNumber - 1) / cellsPerCpl)

what is cellsPerCpl? its not used anywhere else and has a value of 0 as far as I can tell.

bplus · « **Reply #4 on:** November 13, 2021, 05:47:10 pm »

Quote from: Cobalt on November 13, 2021, 02:33:44 pm

in this line

row = INT((boxNumber - 1) / cellsPerCpl)

what is cellsPerCpl? its not used anywhere else and has a value of 0 as far as I can tell.

Wow! I missed that typo. It's supposed to be cellsAcross. Like it is in the fillBox routine and the SurroundBox% routine. I wonder why it's not causing problems in my runs of the program, everything works with that crazy typo!?

Originally I had variable cellsPerRow and cellsPerCol which I changed to cellsAcross and cellsDown because I thought that was better wording. cellsPerCpl is a typo p instead of o, so it didn't get changed when I changed the other variable names.

Well now I've a mystery, that typo should cause problems!

bplus · « **Reply #5 on:** November 13, 2021, 08:12:48 pm »

Yes, I fixed the typo and a host of errors popped up. I should have them all fixed now here:

Code: QB64: [Select]

_Title "Box Surrounded Test" ' b+ 2021-11-12
Randomize Timer
Screen _NewImage(800, 600, 32) '
_Delay .25
_ScreenMove _Middle
Dim Shared cellsDown, cellsAcross, nCells, cellWidth, cellHeight, surroundColor As _Unsigned Long
 
Do
    ' piece of cake to modify this code for different levels just change these 2 lines!!!
    'cellsAcross = Int(Rnd * 13) + 3 ' 3 min, 15 max
    'cellsDown = Int(Rnd * 8) + 3 ' 3 min, 10 max
    ' ====================================================================================
 
    cellsAcross = 3 ' debug    maybe better for building confidence in code
    cellsDown = 3 ' debug
 
 
    nCells = cellsAcross * cellsDown
    cellWidth = Int(_Width / cellsAcross - 1) 'subtract 1 to get borders around all cells on screen
    cellHeight = Int(_Height / cellsDown - 1)
    surroundColor = _RGB32(255, 0, 255) ' purple as I recall
    ReDim Shared BoxesSurrounded(1 To nCells) As Integer
    _Title "Box Surrounded Test: To demo, we need to start with a grid... zzz = Sleep, press any to continue."
    Sleep
    'drawGrid
    For I = 0 To _Width Step cellWidth
        Line (I, 0)-(I, cellsDown * cellHeight)
    Next
    For I = 0 To _Height Step cellHeight
        Line (0, I)-(cellsAcross * cellWidth, I)
    Next
    'label cells (boxes) with id number
    I = 1
    For r = 1 To cellsDown
        For c = 1 To cellsAcross
            _PrintString ((c - 1) * cellWidth + 2, (r - 1) * cellHeight + 2), _Trim$(Str$(I))
            I = I + 1
        Next
    Next
    _Title "Demo BoxSurrounded, next we need to randomly surround 3 boxes... zzz"
    Sleep
    boxes$ = ""
    For I = 1 To 3
        tryAgain:
        B = Int(Rnd * nCells) + 1
        If BoxesSurrounded(B) = 0 Then surroundBox B: BoxesSurrounded(B) = -1: boxes$ = boxes$ + Str$(B) Else GoTo tryAgain
    Next
    _Title "OK now find the boxes (" + boxes$ + ") surrounded with the BoxSurrounded%() Function and light them up!... zzz"
    Sleep
 
    'OK now if a box is surrounded then fill it in
    For I = 1 To nCells
        If BoxSurrounded%(I) Then fillBox I
    Next
    _Title "Escape to quit, any other for another round... zzz"
    Sleep
    Cls
Loop Until _KeyDown(27)
 
Sub fillBox (boxNumber)
    row = Int((boxNumber - 1) / cellsAcross)
    col = (boxNumber - 1) Mod cellsAcross + 1
    Line ((col - 1) * cellWidth + 3, row * cellHeight + 3)-Step(cellWidth - 6, cellHeight - 6), &HFFFFFF00, BF
End Sub
 
Sub surroundBox (boxNumber)
    row = Int((boxNumber - 1) / cellsAcross)
    col = (boxNumber - 1) Mod cellsAcross + 1
    Line ((col - 1) * cellWidth, row * cellHeight)-Step(cellWidth, cellHeight), surroundColor, B
End Sub
 
Function BoxSurrounded% (boxNumber As Integer) 'save already tested boxes in shared array BoxesSurrounded()
    If BoxesSurrounded(boxNumber) = 0 Then
        row = Int((boxNumber - 1) / cellsAcross)
        col = (boxNumber - 1) Mod cellsAcross + 1
        For i = row * cellHeight To row * cellHeight + row
            If Point((col - 1) * cellWidth, i) <> surroundColor Then Exit Function ' False Box not surrounded
            If Point(col * cellWidth, i) <> surroundColor Then Exit Function
        Next
        For i = (col - 1) * cellWidth To col * cellWidth
            If Point(i, row * cellHeight) <> surroundColor Then Exit Function ' False Box not surrounded
            If Point(i, row * cellHeight + row) <> surroundColor Then Exit Function
        Next
        BoxSurrounded% = -1 'all OK
    Else
        BoxSurrounded = -1
    End If
End Function
 
 

News:

Author Topic: How to check if a box has been completed? (Read 25313 times)

Cobalt

How to check if a box has been completed?

bplus

Re: How to check if a box has been completed?

bplus

Re: How to check if a box has been completed?

Cobalt

Re: How to check if a box has been completed?

bplus

Re: How to check if a box has been completed?

bplus

Re: How to check if a box has been completed?