Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
CrossMath Game
#1
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.

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.
Reply
#2
Game should now, more-or-less, be playable.  

Use arrow keys to move through the tiles.  (CTRL-arrow keys move without "smart-skip", in case you have to reach an odd tile.)
Use 1-9 to set a value to a tile
Use 0 to clear the value for a tile.

Set the values of the tiles, until you make all the totals match.

** Instead of leaving a set of number of tiles already visible, I let YOU pick and choose which ones you want to show.  First CONST for the game is the difficultly, and that directly cooresponds to the number of hints you get.  At difficulty 5, you get 5 hints to help you solve the puzzle.

To use a hint, simply press "S" (for show), "H" (for hint), or "?" (question mark), and the game will fill in the tile that you're currently over and subtract one from your total number of hints.



Remember -- RED triangles are the sum of blocks going DOWN.   BLUE triangles give you the sum of blocks going RIGHT.

You don't even need an EXACT match to win -- just so long as those TOTALS match!

Sounds simple, right?

Give it a go and see how well you can do at CROSSMATH!!

(And for those who wonder what I mean by EXACT matches not being required to win, let me do the simplest of illustrations:

6
?
?
?

Now, if the above is our clue and puzzle, there's 3 blocks we need to fill in, and the red 6 tells us the total is 6.  Any of the following would do for the win here:

4, 1, 1
3, 2, 1
3, 1, 2
2, 2, 2
and so on....

You just need to make those values reach the totals, in the direction indicated, to win.  Wink
Reply
#3
Note: As per a report from @grymmjack -- thanks for testing and reporting! -- Linux may toss an error for you, due to pathing and font location.

Change this line (Line 17):
Code: (Select All)
LargeFont = _LOADFONT("courbd.ttf", 48, "monospace")

To point to whatever monochrome font you like on your system.

Windows stores fonts in "C:/Windows/Fonts/", and QB64PE will search there for them. Linux tends to be a little less organized with various places to put stuff, so it has to be spelled out exactly pathwise where/what you want to use.

With this one simple change, it compiled and ran on Linux, so this shouldn't be a hard change for everyone to make to get it working on your system. Wink
Reply
#4
In Linux (in my case debian bookworm):

Code: (Select All)
sudo apt install ttf-mscorefonts-installer

Then you can see where the font for courier is installed like this:

Code: (Select All)
fc-list | grep cour

On my system it was:
Code: (Select All)
/usr/share/fonts/truetype/msttcorefonts/courbd.ttf: Courier New:style=Bold,Negreta,tučné,fed,Fett,Έντονα,Negrita,Lihavoitu,Gras,Félkövér,Grassetto,Vet,Halvfet,Pogrubiony,Negrito,Полужирный,Fet,Kalın,Krepko,đậm,Lodia

So I simply modified Line 17 to be:
Code: (Select All)

LargeFont = _LOADFONT("/usr/share/fonts/truetype/msttcorefonts/courbd.ttf", 48, "monospace")

And it worked.

Note: if you don't have fc-list, you can get fontconfig package:
Code: (Select All)
sudo apt install -y fontconfig

Find out like so:
Code: (Select All)
grymmjack@funkunit:~
$ dpkg -S fc-list
fontconfig: /usr/share/man/man1/fc-list.1.gz
fontconfig: /usr/bin/fc-list

grymmjack@funkunit:~
$ sudo apt info fontconfig
Package: fontconfig
Version: 2.14.1-4
Priority: optional
Section: fonts
Maintainer: Debian freedesktop.org maintainers <pkg-freedesktop-maintainers@lists.alioth.debian.org>
Installed-Size: 632 kB
Depends: libc6 (>= 2.34), libfontconfig1 (>= 2.13.0), libfreetype6 (>= 2.2.1), fontconfig-config
Homepage: https://www.freedesktop.org/wiki/Software/fontconfig/
Tag: implemented-in::c, interface::commandline, role::program,
scope::utility, works-with::font
Download-Size: 449 kB
APT-Manual-Installed: no
APT-Sources: http://deb.debian.org/debian bookworm/main amd64 Packages
Description: generic font configuration library - support binaries
Fontconfig is a font configuration and customization library, which
does not depend on the X Window System. It is designed to locate
fonts within the system and select them according to requirements
specified by applications.
.
Fontconfig is not a rasterization library, nor does it impose a
particular rasterization library on the application. The X-specific
library 'Xft' uses fontconfig along with freetype to specify and
rasterize fonts.
.
This package contains a program to maintain the fontconfig cache
(fc-cache), a sample program to list installed fonts (fc-list), a program
to test the matching rules (fc-match) and a program to dump the binary
cache files in string form (fc-cat). It no longer makes fonts managed by defoma
available to fontconfig applications.

Strangely, the man page is called fonts.conf
Code: (Select All)
man fonts.conf

This will pull up the main package docs.
grymmjack (gj!)
GitHubYouTube | Soundcloud | 16colo.rs
Reply
#5
@SMcNeill you should put the instructions in a intro screen for your game.

This makes it more complete and portable.
grymmjack (gj!)
GitHubYouTube | Soundcloud | 16colo.rs
Reply
#6
i don't get it, all the answers are already on the board:
   
b = b + ...
Reply
#7
(06-04-2024, 05:11 PM)bplus Wrote: i don't get it, all the answers are already on the board:

Just for testing/illustration purposes.  Turn those off via the first CONST and give it a try.

Code: (Select All)
CONST ShowAnswers = 1, Difficulty = 5 'can toggle to show answers, or change difficulty (1 to 10, higher = harder)

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.  Smile

Edit:  I went ahead and toggled the ShowAnswers off in the first post.  Now if folks want to see one possible solution, they have to toggle that on for themselves.
Reply
#8
ok looks a little harder that way Smile
b = b + ...
Reply
#9
oh wow the very next page in a sudoku book i have has 4 pages of Kakuro puzzles!
b = b + ...
Reply
#10
(06-04-2024, 07:13 PM)bplus Wrote: oh wow the very next page in a sudoku book i have has 4 pages of Kakuro puzzles!

That's why I was a little surprised that folks didn't recognize the game, or already have a grasp of the basic ruleset.  It's actually a very common and widespread style game.   Smile
Reply




Users browsing this thread: 4 Guest(s)