My BINGO version

General Computer Utilities
Gearce
Posts: 10
Joined: Sun Apr 15, 2012 8:20 am

My BINGO version

Post by Gearce » Sat Aug 04, 2012 5:46 am

So, I am having a night out at the BINGO. There is the caller, ball-cage, balls and cards and the players, all of which go together to play the game, but no bingoboard on which to place the balls in order to keep a record of the numbers drawn.

There is a computer programme running for this purpose and a projection system to display the numbers on a large screen. When I run the programme and see the computer screen, I understand that in order to record the number drawn, the corresponding number on the screen has to be mouse-clicked, at which time it is highlighted and appears in a large format.

I see an 'UNDO A CALL' button which I presume is to correct an error caused by mouse-clicking the wrong number. Why else?

I also see a 'REVIEW CALLS' button for which purpose I am not sure, since the numbers called are already highlighted.

Understandably, there is also a 'RESET' button and an 'END PROGRAM' button.

Would not it be better if the computer programme made redundant the need for ball-cages, balls and bingoboards. One which had a built-in bingoboard, 'drew' the numbers randomly at a mouse-click, displayed the numbers in a large format and highlighted them in their respective positions on the board and reset the board automatically when required.

Here, then is my suggested such programme, built on my own 'Let's Play Bingo' programme with ideas from TyCamden's 'Bingo Caller 2011' , ElCoyote's 'Bingo Caller (TyCamden) Revised' and Welopez's 'Point-and-Click KENO'.

If you follow the instructions verbatim, the programme works OK but it is flawed however with #main "when characterInput [letter]" in that it is possible to go through the programme just by pressing the 'Y' key with nothing else happening. Big problem to fix? I don't know. Suggestions welcome.

The programme has been designed for 12 games (6 cards x 2 games consisting of the randomly selected option of ANY LINE and FULL CARD or the randomly selected ANY COLUMN and FULL CARD) but can be modified by changing the appropriate segments.

I have used four fonts, Windsordemi (purely for appearance), Arial, Arial Black and Franklin Gothic Heavy. The two Arial fonts and Franklin Gothic Heavy are generally pre-installed but you may have to install Windsordemi. However, should you not wish to install another font, reference to that font can be changed by using the find/replace option but then the appearance would change.

>>>>>>>>>>>>> EDIT 2:39 PM Monday 6th August 2012 <<<<<<<<<<<<<
The flaw "when characterInput [letter]" has been fixed together with a couple of other problems, the solutions for which were by AltBas.

>>>>>>>>>>>>> EDIT 5:42 PM Monday 6th August 2012 <<<<<<<<<<<<<
Misunderstood AltBas. Put right by Stefan. Other modifications made in relation to specifying fonts as suggested by AltBas.

Code: Select all

    '-----------------------------------------------------------------
    '                         AMERICAN STYLE BINGO
    '                        A programme by Gearce
    '                             August 2012
    '    With ideas from programmes by TyCamden, ElCoyote and Wellopez
    '-----------------------------------------------------------------
    '-----------------------------------------------------------------
    ' Declare array/s
    '-----------------------------------------------------------------
    dim the(75),a(75)
    '-----------------------------------------------------------------
    ' Set up
    '-----------------------------------------------------------------
    NOMAINWIN
    WindowWidth=1025
    WindowHeight=767
    UpperLeftX=INT((DisplayWidth-WindowWidth)/2)
    UpperLeftY=INT((DisplayHeight-WindowHeight)-300)
    '-----------------------------------------------------------------
    ' This part is originally by cassiope01 in French, and translated
    ' by me. It gives the day, date, month, year and time when the
    ' programme is run
    '-----------------------------------------------------------------
    month$ = "January February March April May June July August September October November December"
    today$ = date$("mm/dd/yyyy")
    j = date$(today$)
    day$ = word$("Tuesday Wednesday Thursday x Friday Saturday x Sunday Monday",int((j/7-int(j/7))*10)+1)
    date$ = day$+"  "+mid$(today$,4,2)+"  "+word$(month$, val(today$))+"  "+mid$(today$,7,4)+"  at  "+left$(time$(),5)

    open "AMERICAN STYLE BINGO"+space$(60)+date$ for graphics_fs_nsb as #main
    #main "trapclose [quit]"

    #main "down"
    #main "fill black"
    #main "down; backcolor black"
    #main "flush"
    #main "when rightButtonDown [begin]"
    '#main "when characterInput [letter]
    '-----------------------------------------------------------------
    ' Go to welcome subroutine
    '-----------------------------------------------------------------
    gosub [welcome]
    wait
    [begin]
    #main "when rightButtonDown"
    #main "when leftButtonDown [clickit]"
    '-----------------------------------------------------------------
    ' Randomly determine which game to play - 1=Line or 2=Column
    '-----------------------------------------------------------------
    [nextgame]
    previousnumber$=""
    playgame=int(2*rnd(1)+1)
    select case playgame
        case 1:playingfor$="Playing for any LINE"
        case 2:playingfor$="Playing for any COLUMN"
    end select
    clickit=0
    call erasetext1
    '-----------------------------------------------------------------
    ' Increment card counter
    '-----------------------------------------------------------------
    card=card+1
    #main "color 246, 150, 48;font arial_black 20 bold"
    if card>6 then [closeit]
    if card=6 then
        #main "place 55 80;|CARD ";str$(card);". LAST CARD."
        #main "place 55 120;|";playingfor$
    else
        #main "place 55 80;|CARD ";str$(card);"."
        #main "place 55 120;|";playingfor$
    end if
    '-----------------------------------------------------------------
    ' Shuffle numbers
    '-----------------------------------------------------------------
    for nextnumber=1 to 75
        do
            the(nextnumber)=int(75*rnd(1)+1)
            alreadyfound=0
            '---------------------------------------------------------
            ' Check if a number is already found and if yes, generate
            ' another
            '---------------------------------------------------------
            for j=1 to nextnumber
                if a(j)=the(nextnumber) then
                    alreadyfound=1
                    exit for
                end if
            next j
        loop until alreadyfound=0
            a(nextnumber)=the(nextnumber)
    next nextnumber
    '-----------------------------------------------------------------
    ' Go to bingoboard subroutine
    '-----------------------------------------------------------------
    gosub [bingoboard]
    #main "color 246, 150, 48;font arial 12 bold"
    #main "place 55 707;|Left mouse click when ready."
    #main "flush"
    wait
    '-----------------------------------------------------------------
    ' Come here on mouseclick
    '-----------------------------------------------------------------
    [clickit]
    clickit=clickit+1
    if clickit=1 then
        #main "place 55 707;|Eyes down - First number. Left mouse click to start."
        #main "flush"
    end if
    #main "place 996 709;|";str$(clickit-1)
    if clickit=2 then [start]
    if clickit>2 then [nextall]
    wait
    '-----------------------------------------------------------------
    ' Start game play
    '-----------------------------------------------------------------
    [start]
    for all=1 to 75
        gosub [call]
        '-------------------------------------------------------------
        ' Define numbers to determine group
        '-------------------------------------------------------------
        a=1:b=16:c=31:d=46:e=61:f=76
        '-------------------------------------------------------------
        ' B group numbers
        '-------------------------------------------------------------
        for x=a to b-1
            select case x
                case 1:across=768:down=38
                case 2,3,4,5,6,7,8,9:across=768:down=down+45
                case 10,11,12,13,14,15:across=768:down=down+45
            end select
            gosub [highlight]
        next x
        '-------------------------------------------------------------
        ' I group numbers
        '-------------------------------------------------------------
        for x=b to c-1
            select case x
                case 16:across=812:down=38
                case 17,18,19,20,21,22,23,24,25,26,27,28,29,30:across=812:down=down+45
            end select
            gosub [highlight]
        next x
        '-------------------------------------------------------------
        ' N group numbers
        '-------------------------------------------------------------
        for x=c to d-1
            select case x
                case 31:across=857:down=38
                case 32,33,34,35,36,37,38,39,40,41,42,43,44,45:across=857:down=down+45
            end select
            gosub [highlight]
        next x
        '-------------------------------------------------------------
        ' G group numbers
        '-------------------------------------------------------------
        for x=d to e-1
            select case x
                case 46:across=902:down=38
                case 47,48,49,50,51,52,53,54,55,56,57,58,59,60:across=902:down=down+45
            end select
            gosub [highlight]
        next x
        '-------------------------------------------------------------
        ' O group numbers
        '-------------------------------------------------------------
        for x=e to f-1
            select case x
                case 61:across=947:down=38
                case 62,63,64,65,66,67,68,69,70,71,72,73,74,75:across=947:down=down+45
            end select
            gosub [highlight]
        next x

        #main "flush"
        '-------------------------------------------------------------
        ' Go to select subroutine
        '-------------------------------------------------------------
        gosub [select]
        '-------------------------------------------------------------
        ' Loop to scan for keypresses
        '-------------------------------------------------------------
        [loopHere]
        'make sure #main has input focus
        #main, "setfocus"
        'scan for events
        scan
        goto [loopHere]
        '-----------------------------------------------------------------
        ' Come here when key pressed
        '-----------------------------------------------------------------
        [letter]
        if Inkey$=chr$(13) then [quit]
        if Inkey$=chr$(32) then gosub [check]:wait
        if Inkey$=chr$(110) then
            #main "when characterInput"
            call erasetext2
            #main "place 55 707;|Sorry! We have a false claim."
            call Pause 4000
            call erasetext2
            select playgame
                case 1:#main "place 55 707;|Continuing for ANY LINE.  Left mouse click for next number."
                case 2:#main "place 55 707;|Continuing for ANY COLUMN.  Left mouse click for next number."
                case 3:#main "place 55 707;|Continuing for FULL CARD.  Left mouse click for next number."
            end select
            wait
            goto[nextall]
        end if
        if Inkey$=chr$(121) then
            call erasetext2
            #main "place 55 707;|Congratulations! We have a winner."
            call erasetext4
            select case playgame
                #main "color 246, 150, 48;font arial_black 20 bold"
                case 1:#main "place 55 120;|LINE CALL on ";str$(clickit-1);" numbers."
                case 2:#main "place 55 120;|COLUMN CALL on ";str$(clickit-1);" numbers."
                case 3:#main "place 55 120;|FULL CARD CALL on ";str$(clickit-1);" numbers."
            end select
            call Pause 4000
        end if
            #main "when characterInput"
        if playgame=3 then [nextgame]
            #main "color 246, 150, 48;font arial_black 20 bold"
            #main "place 55 120;|Same card.   Continuing for FULL CARD."
        call erasetext2
        playgame=3
        call Pause 2000
        #main "place 55 707;|Continuing for FULL CARD.  Left mouse click for next number"
        wait
        goto [nextall]
        goto [loopHere]
        #main "flush"

    [nextall]
    next all
    wait

    [closeit]
    #main "color 246, 150, 48;font windsordemi 36 112 bold"
    '#main "color 246, 150, 48;font arial 36 112 bold"
    #main "place 55 260;|Hope you had a pleasant"
    #main "|evening. GOOD NIGHT "
    #main "|and hope to see you next"
    #main "|time."
    #main "color 246, 150, 48;font arial 12 bold"
    #main "place 705 707;|Quit via the 'x' Close button top right."
    #main "when characterInput"
    #main "when leftButtonDown"
    #main "when rightButtonDown"
    #main "flush"
    wait
    '-----------------------------------------------------------------
    ' End programme
    '-----------------------------------------------------------------
    [quit]
        Close #main
    END
    '-----------------------------------------------------------------
    ' Welcome subroutine
    '-----------------------------------------------------------------
    [welcome]
        #main "when leftButtonDown"
        #main "color 246, 150, 48;font windsordemi 46 112 bold"
        '#main "color 246, 150, 48;font arial 46 112 bold"
        #main "place 55 260;|Hello and welcome."
        #main "|Enjoy your evening"
        #main "|and GOOD LUCK."
        #main "color 246, 150, 48;font arial 12 bold"
        #main "place 55 707;|Right mouse click to continue."
        #main "flush"
    return
    '-----------------------------------------------------------------
    ' Draw Bingoboard subroutine
    '-----------------------------------------------------------------
    [bingoboard]
        #main "color 246, 150, 48;font windsordemi 25 60 bold"
        '#main "color 246, 150, 48;font arial 25 60 bold"
        #main "place 750 40;|B"
        #main "place 805 40;|I"
        #main "place 839 40;|N"
        #main "place 883 40;|G"
        #main "place 928 40;|O"
        #main "color 246, 150, 48;font arial 12 bold"
        '-------------------------------------------------------------
        ' Draw vertical grid lines
        '-------------------------------------------------------------
        for x=745 to 970, step 45
            #main "line "; x; " "; 50; " "; x; " "; 725
        next x
        '-------------------------------------------------------------
        ' Draw horizontal grid lines
        '-------------------------------------------------------------
        for y=50 to 725, step 45
            #main "line ";745; " "; y; " "; 970;" "; y
        next y
        #main "flush"
        '-------------------------------------------------------------
        ' Write numbers to Bingoboard
        '-------------------------------------------------------------
        for k=1 to 75
            select case k
                case 1:across=764:down=79
                case 2,3,4,5,6,7,8,9:across=764:down=down+45
                case 10,11,12,13,14,15:across=759:down=down+45
                case 16:across=804:down=79
                case 17,18,19,20,21,22,23,24,25,26,27,28,29,30:across=804:down=down+45
                case 31:across=849:down=79
                case 32,33,34,35,36,37,38,39,40,41,42,43,44,45:across=849:down=down+45
                case 46:across=894:down=79
                case 47,48,49,50,51,52,53,54,55,56,57,58,59,60:across=894:down=down+45
                case 61:across=939:down=79
                case 62,63,64,65,66,67,68,69,70,71,72,73,74,75:across=939:down=down+45
            end select
            #main "place ";across;" ";down;";";"|";str$(k)
        next k
    return
    '-----------------------------------------------------------------
    ' Pause subroutine
    '-----------------------------------------------------------------
    sub Pause mil
        t=time$("milliseconds")
        while time$("milliseconds")<t+mil
        wend
    end sub
    '-----------------------------------------------------------------
    ' Highlight called numbers subroutine
    '-----------------------------------------------------------------
    [highlight]
        if a(all)=x then
            #main "color 246, 150, 48; font arial_black 18 bold"
            #main "place ";across;" ";down;";";"|"
            #main "color green; place ";across;" ";down;" boxfilled ";across+50;" ";down+50
            if x<10 then
                #main "place ";across-7;" ";down+42;";";"|";str$(a(all))
            else
                #main "place ";across-16;" ";down+42;";";"|";str$(a(all))
            end if
        end if
        #main "flush"
    return
    '-----------------------------------------------------------------
    ' Call subroutine
    '-----------------------------------------------------------------
    [call]
        select case a(all)
            case 1,2,3,4,5,6,7,8,9:call$="B ";a(all)
            case 10,11,12,13,14,15:call$="B";a(all)
            case 16,17,18,19,20,21,22,23,24,25,26,27,28,29,30:call$="I";a(all)
            case 31,32,33,34,35,36,37,38,39,40,41,42,43,44,45:call$="N";a(all)
            case 46,47,48,49,50,51,52,53,54,55,56,57,58,59,60:call$="G";a(all)
            case 61,62,63,64,65,66,67,68,69,70,71,72,73,74,75:call$="O";a(all)
        end select
        #main "backcolor black"
        call erasetext2
        gosub [large]
        call Pause 2000
        across=708:down=460
        #main "flush"
    return
    '-----------------------------------------------------------------
    ' Display called numbers in large format subroutine
    '-----------------------------------------------------------------
    [large]
        call erasetext3
        #main "color 246, 150, 48;font franklin_gothic_heavy 100 300 bold"
        '#main "color 246, 150, 48;font arial 100 300 bold"
        #main "place 70 400;|";call$
        gosub [previousnumber]
    return
    '-----------------------------------------------------------------
    ' Display previous number called subroutine
    '-----------------------------------------------------------------
    [previousnumber]
        select case a(all-1)
            case 1,2,3,4,5,6,7,8,9:previousnumber$="B ";a(all-1)
            case 10,11,12,13,14,15:previousnumber$="B";a(all-1)
            case 16,17,18,19,20,21,22,23,24,25,26,27,28,29,30:previousnumber$="I";a(all-1)
            case 31,32,33,34,35,36,37,38,39,40,41,42,43,44,45:previousnumber$="N";a(all-1)
            case 46,47,48,49,50,51,52,53,54,55,56,57,58,59,60:previousnumber$="G";a(all-1)
            case 61,62,63,64,65,66,67,68,69,70,71,72,73,74,75:previousnumber$="O";a(all-1)
        end select
        #main "color 246, 150, 48; font arial_black 18 bold"
        #main "place 55 490;|PREVIOUS NUMBER"
        #main "color 246, 150, 48;font franklin_gothic_heavy 40 100 bold"
        '#main "color 246, 150, 48;font arial 40 100 bold"
        #main "place 55 590;|";previousnumber$
    return
    '-----------------------------------------------------------------
    ' Make selection subroutine
    '-----------------------------------------------------------------
    [select]
        #main "when characterInput [letter]"
        #main "backcolor black"
        call erasetext2
        select playgame
            case 1:#main "place 55 707;|Press Spacebar on LINE call or left mouse click for next number."
            case 2:#main "place 55 707;|Press Spacebar on COLUMN call or left mouse click for next number."
            case 3:#main "place 55 707;|Press Spacebar on FULL CARD call or left mouse click for next number."
        end select
        #main "flush"
    return
    '-----------------------------------------------------------------
    ' Check call subroutine
    '-----------------------------------------------------------------
    [check]
        #main "backcolor black"
        call erasetext2
        #main "color 246, 150, 48;font arial 12 bold"
        #main "place 55 707;|";"Checking call - Press 'Y' if correct or 'N' if incorrect."
    return
    '-----------------------------------------------------------------
    ' Erase text subroutines
    '-----------------------------------------------------------------
    sub erasetext1
        #main "color black; place 0 0; boxfilled 1024 767"
        #main "color 246, 150, 48;font arial 12 bold"
    end sub

    sub erasetext2
        #main "color black; place 0 680; boxfilled 740 720"
        #main "color 246, 150, 48;font arial 12 bold"
    end sub

    sub erasetext3
        #main "color black; place 0 140; boxfilled 740 670"
        #main "color 246, 150, 48;font arial 12 bold"
    end sub

    sub erasetext4
        #main "color black; place 0 90; boxfilled 740 130"
        #main "color 246, 150, 48;font arial 12 bold"
    end sub
LANG MEY YER LUM REEK


Life is a coin. You can spend it any way you wish but you can spend it only once