Smallish Games

[bplus]

Here is graphics Sliding Block, you pick the tile number 3x3 to 9x9 then use mouse to click block to move into space:

Code: (Select All)

_Title "GUI repeating Sliding Blocks Game "
Randomize Timer

' get from user the desired board size = s
Do
    Locate CsrLin, 3: Input "(0 quits) Enter your number of blocks per side 3 - 9 you want > ", s
    If s = 0 Then End
Loop Until s > 2 And s < 10

' screen setup: based on the square blocks q pixels a sides
q = 540 / s 'square size, shoot for 540 x 540 pixel board display
Screen _NewImage(q * s + 1, q * s + 1, 32): _ScreenMove 360, 60
Dim board(s, s)

restart:

'initialize board = solution
For r = 1 To s
    For c = 1 To s
        board(c, r) = c + (r - 1) * s
    Next
Next
board(s, s) = 0: c0 = s: r0 = s

'scramble board for puzzle
For i = 0 To s ^ 5 ' mix blocks
    Select Case Int(Rnd * 4) + 1
        Case 1: If c0 < s Then board(c0, r0) = board(c0 + 1, r0): board(c0 + 1, r0) = 0: c0 = c0 + 1
        Case 2: If c0 > 1 Then board(c0, r0) = board(c0 - 1, r0): board(c0 - 1, r0) = 0: c0 = c0 - 1
        Case 3: If r0 < s Then board(c0, r0) = board(c0, r0 + 1): board(c0, r0 + 1) = 0: r0 = r0 + 1
        Case 4: If r0 > 1 Then board(c0, r0) = board(c0, r0 - 1): board(c0, r0 - 1) = 0: r0 = r0 - 1
    End Select
Next

t = Timer: update = -1: mc = 0 'OK user here you go!
Do
    If update Then 'display status and determine if solved
        solved = -1: update = 0
        For r = 1 To s
            For c = 1 To s
                If board(c, r) Then
                    If board(c, r) <> (r - 1) * s + c Then solved = 0
                    Color _RGB32(255, 255, 255), _RGB32(0, 0, 255)
                    Line ((c - 1) * q + 1, (r - 1) * q + 2)-(c * q - 2, r * q - 2), _RGB32(0, 0, 255), BF
                    _PrintString ((c - 1) * q + .4 * q, (r - 1) * q + .4 * q), Right$(" " + Str$(board(c, r)), 2)
                Else
                    If board(s, s) <> 0 Then solved = 0
                    Color _RGB32(0, 0, 0), _RGB32(0, 0, 0)
                    Line ((c - 1) * q, (r - 1) * q)-(c * q, r * q), , BF
                End If
            Next
        Next
        If solved Then 'flash the Solved Report until user closes window else report status
            _Display
            flash$ = "Solved!" + Str$(mc) + " Moves in " + Str$(Int(Timer - t)) + " secs."
            For i = 1 To 20: _Title flash$: _Delay .2: _Title "  ": _Delay .2: Next
            Cls: Color _RGB32(255, 255, 0)
            _PrintString (190, 260), "Another Round?  y for yes"
            k$ = "": _Display
            Do
                k$ = InKey$
            Loop Until Len(k$)
            If k$ = "y" Then Cls: GoTo restart Else End
        Else
            _Title Str$(mc) + " Moves in " + Str$(Int(Timer - t)) + " secs." + Str$(test)
        End If
        _Display
    End If

    'get next mouse click, check if on block next to empty space make move or beep
    m = _MouseInput: mb = _MouseButton(1): mx = _MouseX: my = _MouseY
    If mb And solved = 0 Then 'get last place mouse button was down
        mb = _MouseButton(1): mx = _MouseX: my = _MouseY
        While mb 'left button down, wait for mouse button release
            m = _MouseInput: mb = _MouseButton(1): mx = _MouseX: my = _MouseY
        Wend

        'convert mouse position to board array (x, y) are we near empty space?
        bx = Int(mx / q) + 1: by = Int(my / q) + 1: update = -1
        If bx = c0 + 1 And by = r0 Then
            board(c0, r0) = board(c0 + 1, r0): board(c0 + 1, r0) = 0: c0 = c0 + 1: mc = mc + 1
        ElseIf bx = c0 - 1 And by = r0 Then
            board(c0, r0) = board(c0 - 1, r0): board(c0 - 1, r0) = 0: c0 = c0 - 1: mc = mc + 1
        ElseIf bx = c0 And by = r0 + 1 Then
            board(c0, r0) = board(c0, r0 + 1): board(c0, r0 + 1) = 0: r0 = r0 + 1: mc = mc + 1
        ElseIf bx = c0 And by = r0 - 1 Then
            board(c0, r0) = board(c0, r0 - 1): board(c0, r0 - 1) = 0: r0 = r0 - 1: mc = mc + 1
        Else
            Beep
        End If
    End If
    _Limit 500
Loop

3x3 start:
   

3x3 Solved:
   

[mnrvovrfc]

Good job. LOL. But I suck at all the games posted here.

However this "TriQuad" is quite a good one. This was the post about it:

https://qb64phoenix.com/forum/showthread...4#pid13964

I also happen to play the one written by GNOME. But that also puts numerals over the colored triangles, which doesn't change game play.

[bplus]

here is game carlos brought to my attention at the other place

Code: (Select All)

_Title "Old SHMUP game"
Screen 0: Width 80: Color 15

Dim sk As String
Dim b$, m$, a$
Dim x, y, mx, my, ax, ay

x = 37
y = 23
b$ = " ÜÛÜ  "
aa = 0
a$ = "*"
ma = 0
m$ = "|"

Do
    If Inp(&H60) = 75 Then
        x = x - 1
    End If
    If Inp(&H60) = 77 Then
        x = x + 1
    End If

    If x < 1 Then x = 1
    If x > 75 Then x = 75

    If aa = 0 Then
        ax = Int(Rnd(1) * 76) + 2
        ay = Int(Rnd(1) * y)
        aa = 1
        Locate ay, ax
        Print a$
    End If

    If Inp(&H60) = 57 And ma = 0 Then
        mx = x + 2
        my = y - 1
        ma = 1
    End If

    Locate y, x
    Print b$

    If ma = 1 Then
        Locate my, mx
        Print " "
        my = my - 1

        If my < 1 Then
            ma = 0
        Else
            Locate my, mx
            If mx = ax And my = ay Then
                aa = 0
                ma = 0
                Locate ay, ax
                Print " "
                ax = Int(Rnd(1) * 76) + 2
                ay = Int(Rnd(1) * y)
            Else
                Print m$
            End If
        End If
    End If
    _Display
    _Limit 20
Loop Until InKey$ = Chr$(27) ' Pressionar a tecla Esc para sair

he wanted to build a character editor to change the shape of canon. i showed how he might do that without building character editor (for screen 0 chars, which i'm not sure how to do, graphics screen easy but changing screen 0, don't know...) I went on to make over the whole game, kinda cute

SHMUP mod b+

Code: (Select All)

Option _Explicit
_Title "SHMUP mod 1 b+ 2024-05-02"
Screen 0: Width 80: Color 15

Dim cannon1$, cannon2$, missile$, alien$
Dim As Integer cannonX, cannonY, missileX, missileY, missileActive
Dim As Integer alienX, alienY, alienActive, invaded, repelled, frame
Dim As Long kh
cannonX = 37
cannonY = 23
cannon1$ = " ÜÛÜ " 'this works better
cannon2$ = "ÛÛ ÛÛ"
alienActive = 0
alien$ = "<" + Chr$(233) + ">"
missileActive = 0
missile$ = "|"
'invaded = 60
Do
    Cls
    kh = _KeyHit
    If kh = 19200 Then 'LEFT
        cannonX = cannonX - 1
    ElseIf kh = 19712 Then ' RIGHT
        cannonX = cannonX + 1
    ElseIf kh = 32 And missileActive = 0 Then
        missileX = cannonX + 2
        missileY = cannonY
        missileActive = 1
    End If

    If cannonX < 1 Then cannonX = 1
    If cannonX > 75 Then cannonX = 75

    If alienActive = 0 Then
        alienX = Int(Rnd * 76) + 2 - 1
        alienY = 1
        alienActive = 1
        frame = 0
    Else
        frame = frame + 1
        If frame = 15 Then alienY = alienY + 1: frame = 0
        If alienY = 23 Then
            invaded = invaded + 1
            alienActive = 0
        End If
    End If
    Locate alienY, alienX 'draw invader
    Print alien$

    Locate cannonY, cannonX 'draw canon
    Print cannon1$;
    Locate cannonY + 1, cannonX
    Print cannon2$;

    If missileActive = 1 Then ' handle missile
        missileY = missileY - 1
        If missileY < 1 Then
            missileActive = 0
        Else
            Locate missileY, missileX
            If missileX = alienX + 1 And missileY = alienY Then ' hit
                alienActive = 0
                missileActive = 0
                Locate alienY, alienX
                Print " * "
                repelled = repelled + 1
                _Display
                _Delay .1
                alienX = Int(Rnd(1) * 76) + 2 + 1 'new alien
                alienY = Int(Rnd(1) * cannonY)
            Else
                Print missile$
            End If
        End If
    End If
    _Title "Shumps   Invaded:" + Str$(invaded) + "  Repelled:" + Str$(repelled)
    _Display
    _Limit 60
    If Abs(invaded - repelled) > 25 Then Exit Do
Loop Until InKey$ = Chr$(27) ' Pressionar a tecla Esc para sair
If invaded - repelled > 25 Then
    Locate 12, 27: Print "Game over Aliens took over ;("
ElseIf repelled - invaded > 25 Then
    Locate 12, 28: Print "Game over Aliens defeated :)"
End If
_Display
End