Smallish Games

[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