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

[bplus]

lotto

again inspired by carlos

Code: (Select All)

_Title "lotto for carlos" ' b+ 2024-05-30
Randomize Timer
Width 80, 40 ' <<< 30 so can fit 25 rows on screen 0
Dim a$(1 To 3)
a$(1) = "02 03 05 06 09 10 11 13 14 16 18 20 23 24 25"
a$(2) = "01 04 05 06 07 09 11 12 13 15 16 19 20 23 24"
a$(3) = "01 04 06 07 08 09 10 11 12 14 16 17 20 23 24"
Locate 4
Print CountDigits$(a$(), 25)
Print "    press any for TicketMaker Demo of 7 tickets of 3 numbers from 1 to 100..."
Sleep
Cls
Dim As Long n, numbers, i, top
n = 7: numbers = 3: top = 100
Dim tickets$(1 To n)
Print n; " tickets,"; numbers; " numbers from 1 to"; top; ":"
For i = 1 To n
    tickets$(i) = TicketMaker$(numbers, top)
    Print i, tickets$(i)
Next
Print: Print "Number Counts:"
Print CountDigits$(tickets$(), top)
Print: Print "   press any to input your own specs for a multiple ticket purchase..."
Sleep
Cls
Print
Print "      Multiple tickets purchase:"
Input "Limit 25 for space               Please enter Top number limit "; top
Input "Limit 10 for space  Please enter number of numbers on a ticket "; numbers
Input "Limit  5 for space  Please enter number of tickets to purchase "; n
Cls
If top > 25 Then top = 25
If numbers > 10 Then numbers = 10
If n > 5 Then n = 5
Dim lotto$(1 To n)
Print: Print n; " tickets,"; numbers; " numbers from 1 to"; top; ":"
For i = 1 To n
    lotto$(i) = TicketMaker$(numbers, top)
    Print i, lotto$(i)
Next
Print: Print "Number Counts:"
Print CountDigits$(lotto$(), top)

Function CountDigits$ (digits$(), highest As Long)
    Dim As Long i, j, num, count(1 To highest) '      variables to process digits strings

    Dim rtn$ ' <<<  prepare to set function to return this string when done

    For i = LBound(digits$) To UBound(digits$) ' count the whole array of digit strings
        For j = 1 To Len(digits$(i)) Step 3 '        one digit string break down to 3 digit parts
            num = Val(Mid$(digits$(i), j, 3)) '  convert string to number
            count(num) = count(num) + 1 '        add to count of that number
        Next
    Next
    For i = 1 To highest ' if not 0, lines of counts put into one l o n g string
        If count(i) Then
            rtn$ = rtn$ + S2$(i) + " = " + TS2$(count(i)) + Chr$(10)
        End If
    Next
    CountDigits$ = rtn$ ' <<< returns 25 rows of print in one string
End Function

Function TicketMaker$ (number As Long, highest As Long)
    ' number = number of 2 digit numbers you want
    ' lowest number allowed is always 1
    ' highest number allowed

    ' because no repeats digits, number can not exceed highest

    ' please return the numbers sorted from low to high

    'example:
    ' dim a$(1 to 3)
    ' for i = 1 to 3
    '   a$(i) = TicketMaker$(15, 25)
    ' next
    ' returns:
    'a$(1) = "02 03 05 06 09 10 11 13 14 16 18 20 23 24 25"
    'a$(2) = "01 04 05 06 07 09 11 12 13 15 16 19 20 23 24"
    'a$(3) = "01 04 06 07 08 09 10 11 12 14 16 17 20 23 24"

    Dim As Long shuffle(1 To highest), sort(1 To number), i
    Dim rtn$

    For i = 1 To highest
        shuffle(i) = i
    Next
    For i = highest To 2 Step -1
        Swap shuffle(i), shuffle(Int(Rnd * i) + 1)
    Next
    For i = 1 To number
        sort(i) = shuffle(i)
    Next
    QuickSort 1, number, sort()
    For i = 1 To number
        If Len(rtn$) Then rtn$ = rtn$ + " " + S2$(sort(i)) Else rtn$ = S2$(sort(i))
    Next
    TicketMaker$ = rtn$
End Function

Sub QuickSort (start As Long, finish As Long, array() As Long)
    Dim Hi As Long, Lo As Long, Middle As Long
    Hi = finish: Lo = start
    Middle = array((Lo + Hi) / 2) 'find middle of array
    Do
        Do While array(Lo) < Middle: Lo = Lo + 1: Loop
        Do While array(Hi) > Middle: Hi = Hi - 1: Loop
        If Lo <= Hi Then
            Swap array(Lo), array(Hi)
            Lo = Lo + 1: Hi = Hi - 1
        End If
    Loop Until Lo > Hi
    If Hi > start Then Call QuickSort(start, Hi, array())
    If Lo < finish Then Call QuickSort(Lo, finish, array())
End Sub

Function TS$ (n As Long) ' Trim String for Long Type but integers should work as well
    TS$ = _Trim$(Str$(n))
End Function

Function TS2$ (n As Long) ' Trim String for Long Type but integers should work as well
    TS2$ = Right$("  " + TS$(n), 2)
End Function

Function S2$ (n As Long)
    S2$ = Right$("00" + TS$(n), 2)
End Function

   
   

[JRace]

Neat program.  It might be fun to experiment with, to make it select an optimum distribution of numbers across all tickets to increase the odds of winning something.


If the user is in the habit of pressing <ENTER> to continue from a Sleep statement (as I am), then they may need to add a _KEYCLEAR statement after line 24.  My single press of <ENTER> was read as the <ENTER> key for the first two or three Inputs as well.

[bplus]

ah, I am in habit of spacebar for sleep, thanks for your report.

Carlos seems more interested in seeing the distribution of numbers from their actual history. But we should not count on using history to predict future, except when it comes to sun rises ;-))