Mini-Robo-Mixer generates a sprite sheet of robots.

To those of you who helped with my previous feeble attempt at this programme, thank you!

Alchemy has been completely re-worked and has a few extra features:

• The previous best train of changes for each pair can be viewed.
  
• Selection of a pair is simplified
  
• An additional set of word-pairs can be substituted by "commenting out" the first two data lines.
  
• All files are now correctly attached as a .zip file and can be extracted to the Alchemy folder.
  
  

Attached Files

  wordlists.zip (Size: 713.77 KB / Downloads: 41)

Make5.bas is a small puzzle game where you try to clear the board by removing pieces of the same color.  You remove them by making combinations of 5 or more pieces of the same color in the same row or column.  Click on the ball to move, then click where you want to move it to.  Only large balls can be moved.

Points are scored for pieces that you clear off the board.  When the board gets full and no possible moves left then the game is over.  See how many points you can make before it's over.

This is an updated and enhanced version of the one posted at the old forum.  This new one auto sizes to fit users desktop (not hard coded to a small resolution), the Hi Score is now saved to file, matches are now found both ways at the same time (row+col), and the board and pieces have a better look.

- Dav

'=========

'MAKE5.bas v2.1

'=========

'A board clearing puzzle game.

'Clear the board of balls and score points.

'Make rows/colums of 5 or more of same color.

'Coded by Dav, JUL/2023 for QB64-Phoenix Edition.



'New for version 2.1:

'

'                    - Added _ICON call for Linux users.

'                      (Needed for QB64PE icon to be used by program)

'                    - Removed slow _MOUSEINPUT polling for faster method.

'                    - Because mouse is faster, the board size can now be

'                      bigger on larger desktops (not capped out as before).



'===========

'HOW TO PLAY:

'===========



'Colored balls will appear randomly on the playing board.

'Move bigger balls of same color next to each other to form

'rows and columns of the same color. Make a row/column of 5

'or more of same color to erase them and score points.



'Three new smaller balls will appear after every move.

'The smaller balls will grow into big ones on the next move.

'You may move the big balls on top of the smaller ones.



'The goal is to see how many points you can score before

'running out of board space, in which the game will end.



'High score is save to a 'make5.dat' file.



'You can press SPACE to restart game.



'=========================================================



_ICON



RANDOMIZE TIMER



'This game was originally designed in 600x650.

'Here's a way to adapt that code to adjust larger screens.

'The df is a small display fix for autosizing to desktop.

'The .80 means it will size up to 80% of desktop height

'We will add a *df to any x/y used in a command.

DIM SHARED df: df = (_DESKTOPHEIGHT / 600) * .80



'set original screen size, but use the df value.

SCREEN _NEWIMAGE(600 * df, 650 * df, 32)



DO: LOOP UNTIL _SCREENEXISTS

_TITLE "Make5 Puzzle"



'=== define board info

DIM SHARED rows, cols, size, score, hiscore

rows = 9: cols = 9: size = _WIDTH / cols

DIM SHARED box.v(rows * cols), box.s(rows * cols) 'value, size

DIM SHARED box.x(rows * cols), box.y(rows * cols) 'x/y's

DIM SHARED checks(rows * cols) 'extra array for checking

'

'=== load hi score from file

IF _FILEEXISTS("make5.dat") THEN

    scr = FREEFILE

    OPEN "make5.dat" FOR BINARY AS #scr

    hiscore = CVL(INPUT$(4, scr))

    IF hiscore < 0 THEN hiscore = 0 'a failsafe

    CLOSE #scr

END IF



'=======

restart:

'=======



PLAY "MBL32O3CEGEC"



score = 0



'CLS , _RGB(13, 13, 13)



bc = 1 'counter

FOR c = 1 TO cols

    FOR r = 1 TO rows

        x = (r * size) '(df is already computed in the 'size')

        y = (50 * df) + (c * size)

        box.x(bc) = x - size

        box.y(bc) = y - size

        box.v(bc) = 0 'zero means no color, empty box

        box.s(bc) = 1 ' 1 = small size piece

        bc = bc + 1

    NEXT

NEXT



MakeNewBalls 3, 1 'put 3 big balls on board

MakeNewBalls 3, 2 'put 3 small balls on board



'====

main:

'====



selected = 0



UpdateBoard



second: 'Go back here when making second choice

_DISPLAY



DO



    'wait until mouse button up to continue

    WHILE _MOUSEBUTTON(1) <> 0: n = _MOUSEINPUT: WEND



    WHILE _MOUSEINPUT: WEND



    'highlight box when a box is selected

    IF selected = 1 THEN

        LINE (box.x(t) + 2, box.y(t) + 2)-(box.x(t) + size - 2, box.y(t) + size - 2), _RGB(RND * 255, RND * 255, RND * 255), B

        LINE (box.x(t) + 3, box.y(t) + 3)-(box.x(t) + size - 3, box.y(t) + size - 3), _RGB(RND * 255, RND * 255, RND * 255), B

        LINE (box.x(t) + 4, box.y(t) + 4)-(box.x(t) + size - 4, box.y(t) + size - 4), _RGB(RND * 255, RND * 255, RND * 255), B

        _DISPLAY

    END IF





    'If user clicked mouse

    IF _MOUSEBUTTON(1) THEN



        'see where they clicked

        mx = _MOUSEX: my = _MOUSEY



        'cycle through all Check blocks...

        FOR t = 1 TO (rows * cols)



            'Block loction...

            tx = box.x(t): tx2 = box.x(t) + size

            ty = box.y(t): ty2 = box.y(t) + size



            'if clicked on a box clicked

            IF mx >= tx AND mx <= tx2 THEN

                IF my >= ty AND my <= ty2 THEN



                    'if this is a first choice...

                    IF selected = 0 THEN



                        'only select boxes not empty, with big size balls

                        IF box.v(t) <> 0 AND box.s(t) = 2 THEN

                            selected = 1

                            SOUND 3000, .1 'made a select

                            oldt = t

                            oldtv = box.v(t) 'save picked box number color

                            GOTO second 'now get second choice

                        END IF



                    END IF



                    IF selected = 1 THEN 'making second choice



                        'if selected an empty box or small ball

                        IF box.v(t) = 0 OR box.s(t) = 1 THEN



                            'swap 2nd box data

                            box.v(t) = oldtv

                            box.s(t) = 2

                            'erase 1st box data

                            box.v(oldt) = 0

                            box.s(oldt) = 1

                            SOUND 2000, .1

                            UpdateBoard

                            '===============================



                            'Grow small balls

                            FOR d = 1 TO rows * cols

                                IF box.v(d) <> 0 AND box.s(d) = 1 THEN box.s(d) = 2

                            NEXT



                            UpdateBoard



                            'copy current box values into checking array

                            FOR i = 1 TO (rows * cols)

                                checks(i) = box.v(i)

                            NEXT



                            'check Rows for 5 or more done

                            FOR i = 1 TO (rows * cols) STEP 9

                                CheckRow i

                            NEXT



                            'Check Cols for 5 or more

                            FOR i = 1 TO 9

                                CheckCol i

                            NEXT



                            'copy checking values back into box values

                            FOR i = 1 TO (rows * cols)

                                IF checks(i) = 0 THEN

                                    box.v(i) = 0: box.s(i) = 1

                                END IF

                            NEXT



                            'See how many boxes left to use...

                            howmany = 0

                            FOR h = 1 TO rows * cols

                                'empty ones

                                IF box.v(h) = 0 THEN howmany = howmany + 1

                            NEXT



                            'If not enough spaces left, game over

                            IF howmany < 3 THEN

                                LINE (200 * df, 250 * df)-(400 * df, 350 * df), _RGB(0, 0, 0), BF

                                LINE (200 * df, 250 * df)-(400 * df, 350 * df), _RGB(255, 255, 255), B

                                PPRINT 233 * df, 285 * df, 18 * df, _RGB(255, 255, 255), 0, "GAME OVER"

                                PLAY "mbl16o2bagfedc"

                                _DISPLAY: SLEEP 6

                                GOTO restart

                            END IF



                            'make 3 more random small balls

                            MakeNewBalls 3, 1

                            GOTO main



                        ELSE



                            'if clicked on another big ball instead...

                            IF box.s(t) = 2 THEN

                                'clear previous highlighted selection

                                selected = 0

                                UpdateBoard

                                selected = 1

                                oldt = t

                                oldtv = box.v(t) 'save picked box number color

                                SOUND 3000, .1

                                GOTO second

                            END IF



                        END IF



                    END IF



                END IF

            END IF



        NEXT



    END IF



    _DISPLAY



    IF INKEY$ = " " THEN GOTO restart



LOOP



SUB CheckRow (num)



    'space to hold box nums to clear

    REDIM nums(9)



    'found some to clear flag

    rdone = 0



    'set place and num

    rc = 1

    nums(1) = num



    'step through the boxes



    FOR r = (num + 1) TO (num + 8)



        'if this box is same as previous...

        IF box.s(r) = 2 AND box.v(r) = box.v(nums(rc)) THEN

            'store this box value in nums too

            nums(rc + 1) = r

            'increase how many so far

            rc = rc + 1

        ELSE

            'bot same, so reset



            IF rdone = 0 THEN

                'no more, so start over from here

                ERASE nums

                REDIM nums(9)

                rc = 1: nums(1) = r

            ELSE

                'no more can exists on line

                EXIT FOR

            END IF

        END IF



        'if there was 5 or more found

        IF rc >= 5 THEN rdone = 1



    NEXT



    'if group was found, clear

    IF rdone = 1 THEN

        PLAY "mbl32o3cdefga"

        'step through nums values

        FOR d = 1 TO 9

            IF nums(d) <> 0 THEN



                score = score + 55 '55 points per ball



                x = box.x(nums(d)): y = box.y(nums(d))

                LINE (x + 2, y + 2)-(x + size - 2, y + size - 2), _RGB(255, 255, 255), BF

                _DELAY .025: _DISPLAY

                LINE (x + 2, y + 2)-(x + size - 2, y + size - 2), _RGB(64, 64, 64), BF

                _DELAY .025: _DISPLAY

                checks(nums(d)) = 0 'mark checking array

            END IF

        NEXT

    END IF



    ERASE nums



END SUB



SUB CheckCol (num)



    'space to hold box nums to clear

    REDIM nums(9)



    'found some to clear flag

    rdone = 0



    'set place and num

    rc = 1

    nums(1) = num



    'step through the boxes



    FOR r = (num + 9) TO (rows * cols) STEP 9



        'if this box is same as previous...

        IF box.s(r) = 2 AND box.v(r) = box.v(nums(rc)) THEN

            'store this box value in nums too

            nums(rc + 1) = r

            'increase how many so far

            rc = rc + 1

        ELSE

            'bot same, so reset



            IF rdone = 0 THEN

                'no more, so start over from here

                ERASE nums

                REDIM nums(9)

                rc = 1: nums(1) = r

            ELSE

                'no more can exists on line

                EXIT FOR

            END IF

        END IF



        'if there was 5 or more found

        IF rc >= 5 THEN rdone = 1



    NEXT



    'if group was found, clear

    IF rdone = 1 THEN

        PLAY "mbl32o3cdefga"

        'step through nums values

        FOR d = 1 TO 9

            IF nums(d) <> 0 THEN

                score = score + 55 'add to score

                x = box.x(nums(d)): y = box.y(nums(d))

                LINE (x + 2, y + 2)-(x + size - 2, y + size - 2), _RGB(255, 255, 255), BF

                _DELAY .025: _DISPLAY

                LINE (x + 2, y + 2)-(x + size - 2, y + size - 2), _RGB(64, 64, 64), BF

                _DELAY .025: _DISPLAY

                checks(nums(d)) = 0 'mark checking array

            END IF

        NEXT

    END IF



    ERASE nums



END SUB





SUB UpdateBoard



    CLS , _RGB(96, 96, 96)



    PPRINT 20 * df, 14 * df, 15 * df, _RGB(255, 255, 0), 0, "SCORE:" + LTRIM$(STR$(score))

    IF score >= hiscore THEN

        hiscore = score

        SaveScore

    END IF

    PPRINT 475 * df, 14 * df, 15 * df, _RGB(255, 150, 150), 0, "HI:" + LTRIM$(STR$(hiscore))



    PPRINT 222 * df, 12 * df, 24 * df, _RGB(1, 1, 1), 0, "-=MAKE5=-"

    PPRINT 220 * df, 10 * df, 24 * df, _RGB(255, 255, 255), 0, "-=MAKE5=-"



    '=== draw board based on box values

    bc = 1 'counter

    FOR cl = 1 TO cols

        FOR ro = 1 TO rows

            '=== if empty box

            IF box.v(bc) = 0 THEN

                LINE (box.x(bc) + 2, box.y(bc) + 2)-(box.x(bc) + size - 2, box.y(bc) + size - 2), _RGB(32, 32, 32), BF

            ELSE

                LINE (box.x(bc) + 2, box.y(bc) + 2)-(box.x(bc) + size - 2, box.y(bc) + size - 2), _RGB(32, 32, 32), BF

                '=== draw color ball

                x2 = box.x(bc) + (size / 2) 'find middle of box

                y2 = box.y(bc) + (size / 2)

                IF box.s(bc) = 1 THEN sz = size / 4 ELSE sz = size / 2

                SELECT CASE box.v(bc)

                    CASE IS = 1: r = 255: g = 64: b = 64 'red

                    CASE IS = 2: r = 64: g = 232: b = 64 'green

                    CASE IS = 3: r = 64: g = 64: b = 255 'blue

                    CASE IS = 4: r = 255: g = 255: b = 0 'yellow

                    CASE IS = 5: r = 255: g = 255: b = 255 'white

                END SELECT

                'draw colored balls

                FOR s = 1 TO (sz - 4) STEP .3

                    CIRCLE (x2, y2), s, _RGB(r, g, b)

                    r = r - 1: g = g - 1: b = b - 1

                NEXT



            END IF

            bc = bc + 1

        NEXT

    NEXT



    'overlay a very faint QB64-PE icon on board

    _SETALPHA 16, , -11: _PUTIMAGE (0, 50 * df)-(_WIDTH, _HEIGHT), -11



    _DISPLAY

    _ICON _DISPLAY 'update app icon on taskbar

END SUB



SUB MakeNewBalls (num, ballsize)

    'Assign 3 new balls

    newball = 0

    DO

        c = INT((RND * (cols * rows)) + 1)

        IF box.v(c) = 0 THEN

            box.v(c) = INT((RND * 5) + 1)

            box.s(c) = ballsize

            newball = newball + 1

        END IF

        IF newball = num THEN EXIT DO

    LOOP

END SUB



SUB PPRINT (x, y, size, clr&, trans&, text$)

    orig& = _DEST

    bit = 32: IF _PIXELSIZE(0) = 1 THEN bit = 256

    FOR t = 0 TO LEN(text$) - 1

        pprintimg& = _NEWIMAGE(16, 16, bit)

        _DEST pprintimg&

        CLS , trans&: COLOR clr&

        PRINT MID$(text$, t + 1, 1);

        _CLEARCOLOR _RGB(0, 0, 0), pprintimg&

        _DEST orig&

        x1 = x + (t * size): x2 = x1 + size

        y1 = y: y2 = y + size

        _PUTIMAGE (x1 - (size / 2), y1)-(x2, y2 + (size / 3)), pprintimg&

        _FREEIMAGE pprintimg&

    NEXT

END SUB



SUB SaveScore

    'Out with the old

    IF _FILEEXISTS("make5.dat") THEN KILL "make5.dat"

    'In with the new

    scr = FREEFILE

    OPEN "make5.dat" FOR OUTPUT AS #scr

    hi$ = MKL$(hiscore)

    PRINT #scr, hi$;

    CLOSE #scr

END SUB

Until I get around to building in some substantial features, the following took me all of a half hour to setup just to have something useful:

   

Everyone who knows graphics knows PSET.  Right?

Now, let's be honest -- How many of you guys think that PRESET is just a longhand version of PSET?  Same command, just with more typing!  After all, what's the difference between these two programs:

I've been trying to make this work but I'm stumped.

I messed around with a 3d points program by MasterGy and managed to get a sense of the space and coordinates.   There's something that I can't seem to grasp though...that's placing an image onto a surface (using _maptriangle).

In this program, I wanted to place an image on the 'floor'.   So I started by placing about 600 small tiles in a grid, exactly where I want to place the image.   But images always rotate towards the viewer.   Even the small tiles do this.   The grid of tiles (as a whole) doesn't do this - only each individual tile.   How to lay the image flat is what I'm trying to figure out.   

So if anyone here knows how this works....

I'll attach the image I'm trying to use but any 750x750 image will do.

Attached Files

Thumbnail(s)
   

Just a little comma confusion on my part.

https://qb64phoenix.com/qb64wiki/index.php/MAPTRIANGLE

This is from example 3 - about the half-way point in the program:

I was studying "Bitwise NOT", and just had this thought about what impact that would have on color when applied to each of the RGB values.

Is there any related "color theory" that discusses anything similar to this sample code I just wrote?

Note: I've got a few things I need to fix up to make this a QB64-compatible program.

As-is, it is a fun for-the-giggles bit of code to glance at.

• View the source code
  
• Run the program
  

Is there a fast way to test whether 2 images are exactly the same?