Inspired by some of @Dav 's latest works, this is the start of a little Crossword type game, but which features addition instead of letters.
The way this works is it creates a crossword style grid, and then it gives you some clues in the form of the colored tiles and numbers. Red is the sum of the numbers adding downwards. Blue is the sum of the numbers adding right.
Game is loosely based off a variety of the puzzle Kakuro: https://www.kakuroconquest.com
Main difference here is I'm not checking for unique values, so you can have the same value multiple times in a row/column, which means there's no "unique" solution to puzzle.
Code: (Select All)
$COLOR:32
CONST ShowAnswers = 0, Difficulty = 5 'can toggle to show answers, or change difficulty (1 to 10, higher = harder)
RANDOMIZE TIMER
SCREEN _NEWIMAGE(1280, 720, 32)
DIM SHARED AS INTEGER grid(-1 TO 10, -1 TO 10), player(-1 TO 10, -1 TO 10)
DO
randomgrid
PlayGame
LOOP
SUB PlayGame
'find first block
Show = 10 - Difficulty 'player can show up to 3 blocks to help them with the puzzle
IF Show < 0 THEN Show = 0
LargeFont = _LOADFONT("courbd.ttf", 48, "monospace")
FOR y = 0 TO 9
FOR x = 0 TO 9
IF grid(x, y) GOTO start
NEXT
NEXT
start:
Xon = x: Yon = y
DO
CLS
drawgrid
'draw player highlight
LINE (Xon * 60 + 60, Yon * 60 + 60)-STEP(60, 60), Green, BF
k = _KEYHIT
IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN
SELECT CASE k
CASE 19200: IF Xon > 0 THEN x = Xon - 1 'CTRL + left arrow
CASE 19712: IF Xon < 9 THEN Xon = Xon + 1 'CTRL + right arrow
CASE 18432: IF Yon > 0 THEN Yon = Yon - 1 'CTRL + up arrow
CASE 20480: IF Yon < 9 THEN Yon = Yon + 1 'CTRL + down arrow
END SELECT
ELSE
SELECT CASE k
CASE 48 TO 57 'number keys
IF grid(Xon, Yon) THEN player(Xon, Yon) = k - 48
CASE 27 'ESC
SYSTEM
CASE 19200 'left arrow
FOR x = Xon - 1 TO 0 STEP -1
IF grid(x, Yon) THEN Xon = x: EXIT FOR
NEXT
CASE 19712 'right arrow
FOR x = Xon + 1 TO 9
IF grid(x, Yon) THEN Xon = x: EXIT FOR
NEXT
CASE 18432 'up arrow
FOR y = Yon - 1 TO 0 STEP -1
IF grid(Xon, y) THEN Yon = y: EXIT FOR
NEXT
CASE 20480 'down arrow
FOR y = Yon + 1 TO 9
IF grid(Xon, y) THEN Yon = y: EXIT FOR
NEXT
CASE ASC("S"), ASC("s"), ASC("H"), ASC("h"), ASC("?")
IF Show THEN
player(Xon, Yon) = grid(Xon, Yon)
Show = Show - 1
END IF
END SELECT
END IF
_FONT LargeFont
_PRINTSTRING (800, 40), "HINTS:" + STR$(Show)
FOR x = 0 TO 9 'Display the current numbers
FOR y = 0 TO 9
IF player(x, y) THEN _PRINTSTRING (x * 60 + 70, y * 60 + 66), _TRIM$(STR$(player(x, y)))
NEXT
NEXT
win = -1
FOR x = -1 TO 9
FOR y = -1 TO 9
IF CheckDown(grid(), x, y) <> CheckDown(player(), x, y) THEN win = 0: GOTO keep_playing
NEXT
NEXT
IF win THEN
BEEP
BEEP
BEEP
_PRINTSTRING (800, 110), "YOU WIN!!!"
_DISPLAY
SLEEP
EXIT SUB
END IF
keep_playing:
_FONT 16
_DISPLAY
_LIMIT 30
LOOP
END SUB
SUB randomgrid
FOR x = -1 TO 10 'reset the game values to 0
FOR y = -1 TO 10
grid(x, y) = 0
player(x, y) = 0
NEXT
NEXT
FOR j = 1 TO 90
x = INT(RND * 10)
y = INT(RND * 10)
z = INT(RND * 9) + 1
grid(x, y) = z
NEXT
DO 'this eliminates any stray numbers just floating off by themselves
fixed = -1
FOR x = 0 TO 9
FOR y = 0 TO 9
IF grid(x, y) <> 0 THEN
IF grid(x - 1, y) = 0 AND grid(x, y - 1) = 0 AND grid(x, y + 1) = 0 AND grid(x + 1, y) = 0 THEN
grid(x, y) = 0
x = INT(RND * 10)
y = INT(RND * 10)
z = INT(RND * 10)
grid(x, y) = z
fixed = 0
END IF
END IF
NEXT
NEXT
LOOP UNTIL fixed
END SUB
SUB drawgrid
startX = 60
startY = 60
endX = 660
endY = 660
FOR x = startX TO endX STEP 60
LINE (x, 60)-(x, 660)
NEXT
FOR y = startY TO endY STEP 60
LINE (60, y)-(660, y)
NEXT
FOR y = -1 TO 9
FOR x = -1 TO 9
IF grid(x, y) = 0 THEN
x1 = x * 60 + 60: y1 = y * 60 + 60
LINE (x1, y1)-STEP(60, 60), LightGray, BF
sum = CheckDown(grid(), x, y)
IF sum THEN
COLOR Black, 0
FillTriangle x1, y1, x1 + 60, y1, x1, y1 + 60, Red
_PRINTSTRING (x1 + 5, y1 + 5), STR$(sum)
END IF
sum = CheckRight(grid(), x, y)
IF sum THEN
COLOR White, 0
FillTriangle x1 + 60, y1, x1, y1 + 60, x1 + 60, y1 + 60, Blue
_PRINTSTRING (x1 + 35, y1 + 35), STR$(sum)
END IF
ELSE
COLOR White, 0
IF ShowAnswers THEN _PRINTSTRING (x * 60 + 80, y * 60 + 80), "(" + STR$(grid(x, y)) + ")"
END IF
NEXT
NEXT
END SUB
SUB FillTriangle (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
$CHECKING:OFF
STATIC a&, m AS _MEM
IF a& = 0 THEN a& = _NEWIMAGE(1, 1, 32): m = _MEMIMAGE(a&)
_MEMPUT m, m.OFFSET, K
_MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
$CHECKING:ON
END SUB
FUNCTION CheckDown (array() AS INTEGER, x, y)
sum = 0
FOR i = y + 1 TO 9
IF array(x, i) <> 0 THEN
sum = sum + array(x, i)
ELSE
EXIT FOR
END IF
NEXT
IF sum <> array(x, y + 1) THEN CheckDown = sum ELSE CheckDown = 0
END FUNCTION
FUNCTION CheckRight (array() AS INTEGER, x, y)
sum = 0
FOR i = x + 1 TO 9
IF array(i, y) <> 0 THEN
sum = sum + array(i, y)
ELSE
EXIT FOR
END IF
NEXT
IF sum <> array(x + 1, y) THEN CheckRight = sum ELSE CheckRight = 0
END FUNCTION
The way this works is it creates a crossword style grid, and then it gives you some clues in the form of the colored tiles and numbers. Red is the sum of the numbers adding downwards. Blue is the sum of the numbers adding right.
Game is loosely based off a variety of the puzzle Kakuro: https://www.kakuroconquest.com
Main difference here is I'm not checking for unique values, so you can have the same value multiple times in a row/column, which means there's no "unique" solution to puzzle.