' ********************************
' *         ST - BINGO           *
' *     ATARI ST- COMPUTERS      *
' *         A.BAGGETTA           *
' *       GFA BASIC V.2.0        *
' *            1988              *
' ********************************
Dim L$(5),N$(100),Sv$(1000),Comptr1%(5,5),Comptr2%(5,5),Ct%(25)
Dim B(5),I(5),N(5),G(5),O(5),Bb(5),Ii(5),Nn(5),Gg(5),Oo(5),C(5)
Dim Oldcolri(15),Oldcolrr(15),Oldcolrg(15),Oldcolrb(15)
Dim Msa(50),Msb(50),Msc(50),Msd(50),Mse(50),Pm(50),Pcm(50),Pcmr(50)
@Colr_get                                 !Save the colors
Cls
If Exist("Winner.fil") Then               !Check for Winner File
  Print "Loading Winner file..."          !If ok load the file.  If not
  Open "I",#1,"Winner.fil"                !Start over again
  Input #1,Win$
  Close #1
Else
  Alert 3," | |Missing Winner File",1,"END",Ab
  Goto Finish
Endif
Cls
Start_prg:
Cls                                       !Clear the screen and set the
Restore Clrz                              !Screen colors
For Clrz%=1 To 9
  Read Cl1,Cl2,Cl3,Cl4
  Setcolor Cl1,Cl2,Cl3,Cl4
Next Clrz%
Clrz:
Data 0,0,0,0,1,7,7,7,2,2,3,2,3,5,3,1,4,7,2,3,6,4,5,3,7,2,4,3,9,5,4,3,15,7,7,7
Rna=1000                                 !Select a random amount for prize
Rnb=5000                                 !Money
Cpz=Int(Rnd*(Rnb-Rna+1))+Rna
X%=0
Deffill 2,2,7                            !Set up the menu screen
Pbox 8,10,296,199
Graphmode 4
Deftext 4,4,0,32
Text 38,44,"   ST-BINGO   "
Graphmode 1
Deffill 3,2,8
Prbox 20,55,285,185
Defline 6,2,0,0
Prbox 20,55,285,185
Rbox 20,55,285,185
Graphmode 2
Deftext 5,5,0,9
Text 50,80,"Your Selection?"
Deftext 6,5,0,8
Text 100,100,"Play Bingo"
Text 100,120,"Make Cards"
Text 100,140,"Quit"
D$=Chr$(14)+Chr$(15)
Dup$=String$(9,D$)
Deftext 1,5,0,8
Text 50,160,Dup$
Color 6
Circle 85,98,5
Circle 85,118,5
Circle 85,138,5
Showm
Do                                      !Mouse control for the Menu Screen
  Mouse Mc,Mr,Mb
  If (Mc>80 And Mc<90) And (Mr>95 And Mr<101) And Mb=1
    Graphmode 1
    Deffill 3,2,8
    Prbox 20,55,285,185
    @Play_bingo
    Goto Start_prg
  Endif
  If (Mc>80 And Mc<90) And (Mr>115 And Mr<123) And Mb=1
    Print At(10,5);"make cards"
    Cls
    Goto Make_cards
    Goto Start_prg
  Endif
  If (Mc>80 And Mc<90) And (Mr>135 And Mr<141) And Mb=1
    Cls
    Goto Finish
  Endif
Loop
'
Procedure Play_bingo
  Leave=0 !LEAVE GAME FLAG
  Cd=0 !CARD # FLAG
  @Array_set                         !Clear the arrays
  '                                   Set up the main screen to play BINGO
  Deffill 0,2,8
  Graphmode 2
  Text 85,100,"                 "
  Line 100,79,204,79
  Line 100,113,204,113
  For Grow=100 To 204 Step 2
    Pbox 100,80,Grow,112
  Next Grow
  Deftext 1,4,0,6
  Text 110,93,"Let's Play"
  Text 125,103,"BINGO!"
  Deffill 10,2,8
  Prbox 102,125,204,135
  Deffill 6,2,8
  Prbox 50,150,120,165
  Prbox 185,150,255,165
  Deffill 11,2,8
  Defline 1,3,0,0
  Color 8
  Rbox 20,55,285,185
  Rbox 102,125,204,135
  Rbox 50,150,120,165
  Rbox 185,150,255,165
  Deftext 3,16,0,5
  Graphmode 2
  Text 67,160,"CALL"
  Text 197,160,"BINGO!"
  Deftext 3,0,0,4
  Text 110,132,"AUTO CALL - OFF"
  Deftext 1,0,0,4
  Defline 1,1,0,0
  Color 0
  '
  Restore Small_crds                     !Draw the computer's cards
  For Smx%=1 To 20
    Read Sma,Smb,Smc,Smd
    If Smx%=1 Or Smx%=11 Then
      Rbox Sma,Smb,Smc,Smd
    Else
      Line Sma,Smb,Smc,Smd
    Endif
  Next Smx%
  Graphmode 2
  Deftext 1,1,0,4
  Text 28,68,"B"
  Text 44,68,"I"
  Text 60,68,"N"
  Text 74,68,"G"
  Text 90,68,"O"
  Deftext 1,0,0,4
  Restore Comp_crd1
  '
  ' Store the numbers on card 1 in an array comptr1%(xx,yy)
  '
  Freebe=0
  Xx=0
  Yy=0
  For Rp%=1 To 25
    Read C,R
    N=Int(Rnd*75)+1
    N$=Str$(N)
    If Len(N$)=1
      N$=" "+N$
    Endif
    If Rp%<>13 Then
      Text C,R,N$
    Else
      Deftext 10,0,0,4
      Text C,R,"FR"
      Deftext 1,0,0,4
    Endif
    If Rp%>0 And Rp%<6 Then
      Xx=1
    Endif
    If Rp%>5 And Rp%<11 Then
      Xx=2
    Endif
    If Rp%>10 And Rp%<16 Then
      Xx=3
    Endif
    If Rp%>15 And Rp%<21 Then
      Xx=4
    Endif
    If Rp%>20 And Rp%<26 Then
      Xx=5
    Endif
    If Yy=5 Then
      Yy=0
    Endif
    Yy=Yy+1
    If Rp%=13 Then
      N=-1
    Endif
    Comptr1%(Xx,Yy)=N
  Next Rp%
  '
  Deftext 1,1,0,4
  Text 211,68,"B"
  Text 227,68,"I"
  Text 242,68,"N"
  Text 257,68,"G"
  Text 272,68,"O"
  Deftext 1,0,0,4
  '
  Restore Comp_crd2
  '
  ' Store the numbers on card 2 in an array comptr2%(xx,yy)
  '
  Freebe=0
  Xx=0
  Yy=0
  For Rp%=1 To 25
    Read C,R
    N=Int(Rnd*75)+1
    N$=Str$(N)
    If Len(N$)=1
      N$=" "+N$
    Endif
    If Rp%<>13 Then
      Text C,R,N$
    Else
      Deftext 10,0,0,4
      Text C,R,"FR"
      Deftext 1,0,0,4
    Endif
    If Rp%>0 And Rp%<6 Then
      Xx=1
    Endif
    If Rp%>5 And Rp%<11 Then
      Xx=2
    Endif
    If Rp%>10 And Rp%<16 Then
      Xx=3
    Endif
    If Rp%>15 And Rp%<21 Then
      Xx=4
    Endif
    If Rp%>20 And Rp%<26 Then
      Xx=5
    Endif
    If Yy=5 Then
      Yy=0
    Endif
    Yy=Yy+1
    If Rp%=13 Then
      N=-1
    Endif
    Comptr2%(Xx,Yy)=N
  Next Rp%
  Deftext 11,0,0,4
  Text 105,68,Chr$(4)+"COMPUTER CARDS"+Chr$(3)
  Deftext 11,0,0,4
  Text 40,135,"CARD #1"
  Text 223,135,"CARD #2"
  Graphmode 2
  Box 145,153,160,162
  Text 148,159,Chr$(14)+Chr$(15)
  Deftext 1,1,0,4
  Text 141,169,"QUIT"
  Deftext 1,0,0,4
  Graphmode 4
  Text 45,172," Last Winner "
  Text 183,172," Cash Prize  "
  Graphmode 2
  Text 60,180,Win$
  Text 195,180,"$"+Str$(Cpz)+".00"
  Graphmode 1
  Yup=0
  T:
  Do                                    !Game Mouse Control
    Showm
    Mouse Mc,Mr,Mb
    If (Mc>50 And Mc<120) And (Mr>150 And Mr<165) And Mb=1
      Goto Jout
    Endif
    If (Mc>185 And Mc<255) And (Mr>150 And Mr<165) And Mb=1
      Hidem
      Sget Screen$
      @Check_bingo
      If Yup Then
        Goto Sto
      Endif
    Endif
    If (Mc>100 And Mc<200) And (Mr>125 And Mr<135) And Mb=1
      Graphmode 2
      Color 8
      Deffill 10,2,8
      Prbox 102,125,204,135
      Defline 1,3,0,0
      Rbox 102,125,204,135
      Deftext 3,0,0,4
      Text 110,132,"AUTO CALL - ON"
      Graphmode 1
      Deftext 1,0,0,12
      Auto=1
      Goto Jout
    Endif
    If (Mc>145 And Mc<160) And (Mr>153 And Mr<162) And Mb=1
      Goto Sto
    Endif
  Loop
  Jout:
  Showm
  Deftext 1,0,0,12
  Deffill 3,2,8
  For Grow=204 To 100 Step -2        !Clear the old Bingo number
    Sound 1,15,Grow/8,4
    Pbox Grow,80,204,112
  Next Grow
  Sound 1,0
  Deffill 0,2,8
  For Grow=100 To 204 Step 2
    Sound 1,15,Grow/8,4
    Pbox 100,80,Grow,112
  Next Grow
  Sound 1,0
  Try_again:
  Tg=0                                !Select Bingo number
  Lter=Int(Rnd*5)+1
  N=Int(Rnd*75)+1
  For Cut%=0 To X%
    If Sv$(Cut%)=L$(Lter)+Str$(N) Then
      Tg=1
    Endif
  Next Cut%
  If Tg=1 Then
    Goto Try_again
  Endif
  Ck$=L$(Lter)
  @Chk_comp_crd(Ck$)                 !Run a check on the cards
  If Leave=1 Then
    Deftext 1,4,0,32
    If Cd=1 Then
      Get 23,57,100,128,Cd$ ! CUT CARD ONE FROM SCREEN
      Cls
      Text 70,30,"ST-BINGO"
      Setcolor 0,4,0,0
      Put 100,50,Cd$,3
      Print At(15,19);"CARD #1"
      Print At(12,21);"COMPUTER WINS"
      Win$="COMPUTER"
      Open "o",#1,"Winner.fil"
      Write #1,Win$
      Close #1
      Pause 400
      Goto Sto
    Else
      If Cd=2 Then
        Get 205,57,282,128,Cd$
        Cls
        Text 70,30,"ST-BINGO"
        Setcolor 0,4,0,0
        Put 100,50,Cd$,3
        Print At(15,19);"CARD #2"
        Print At(12,21);"COMPUTER WINS"
        Win$="COMPUTER"
        Open "o",#1,"Winner.fil"
        Write #1,Win$
        Close #1
        Pause 400
        Goto Sto
      Endif
    Endif
  Endif
  Jmphere:
  Text 108,100,L$(Lter)+"  "+Str$(N)
  ' Save the letter/number combination for later check
  X%=X%+1
  Sv$(X%)=L$(Lter)+Str$(N)
  If Auto=1
    For Del=1 To 75000
      Showm
    Next Del
  Endif
  Repeat
    Mouse Mc,Mr,Mb
    If Mb=2 Then
      Inc Visit
      If Visit=1
        Print At(17,14);"PAUSE"
      Endif
    Endif
  Until Mb<>2
  If Mb<>2
    Print At(17,14);"         "
    Visit=0
  Endif
  If (Mc>100 And Mc<200) And (Mr>125 And Mr<135) And Mb=1
    Auto=0
    Graphmode 2
    Color 8
    Deffill 10,2,8
    Prbox 102,125,200,135
    Defline 1,3,0,0
    Rbox 102,125,200,135
    Deftext 3,0,0,4
    Text 110,132,"AUTO CALL - OFF"
    Graphmode 1
    Deftext 1,0,0,12
    Pause 50
  Endif
  If Auto=0 Then
    Goto T
  Else
    Goto Jout
  Endif
  Sto:
Return
'
Make_cards:
Count=0
Setcolor 0,7,7,7                        ! Set new screen colors
Setcolor 1,5,2,3
Setcolor 15,0,0,0
Deftext 1,0,0,15
Text 70,50,"Bingo Card Designer"        ! Set up Alert String
Alert$="Before Printing Bingo Card        |be sure your printer is set  |to 960 dots per line.  "
Alert 0,Alert$,0,"Randomly|Personal|Quit",Choose
If Choose=1 Then                        ! Alert Box choices
  Goto Make_one
Endif
If Choose=2 Then
  Goto Make_two
Endif
If Choose=3 Then
  Goto Start_prg
Endif
Make_one:                               ! Design the first type of card
Cls
Tcrd:
Cls
Color 1
Defline 0,3,0,0
Rbox 30,10,250,185
Defline 0,2,0,0
Line 74,10,74,185
Line 118,10,118,185
Line 162,10,162,185
Line 206,10,206,185
Defline 0,3,0,0
Line 30,39,250,39
Defline 0,2,0,0
Line 30,68,250,68
Line 30,97,250,97
Line 30,126,250,126
Line 30,155,250,155
' fill in the labels on the large card
Deftext 2,4,0,20
Restore Big_crds_lbls
For Bigx%=1 To 30
  Read Biga,Bigb,Bigc$
  If Bigx%=6 Then
    Deftext 1,0,0,4
  Endif
  Text Biga,Bigb,Bigc$
Next Bigx%
Deftext 2,0,0,10
Restore Cdata
Freebe=0
For Rp=1 To 25                        ! Put numbers on the card
  Read C,R
  N=Int(Rnd*75)+1
  N$=Str$(N)
  If Len(N$)=1
    N$=" "+N$
  Endif
  If Freebe<2 Then
    Free=Int(Rnd*15)+1
    If Free=9
      Inc Freebe
      Deftext 2,0,0,7
      Text C-7,R,"FREE"
      Deftext 2,0,0,10
      Goto Jmp
    Endif
  Endif
  If Rp<>13 Then
    Text C,R,N$
  Else
    Deftext 2,0,0,7
    Text C-7,R,"FREE"
    Deftext 2,0,0,10
  Endif
  Jmp:
Next Rp
Deftext 1,0,0,4                         ! Check to see if card is OK
Text 260,50,"Card OK?"
Box 260,70,270,80
Box 290,70,300,80
Box 260,85,300,95
Text 263,77,"Y"
Text 293,77,"N"
Text 268,92,"QUIT"
Inc Count
Text 263,110,"CARD #"+Str$(Count)
Do
  Mouse Mc,Mr,Mb
  If (Mc>260 And Mc<270) And (Mr>70 And Mr<80) And Mb=1
    Hidem
    Deffill 0,2,8
    Pbox 260,40,370,120
    Hardcopy
    Showm
    For Mulcop=1 To 35
      Lprint
    Next Mulcop
    Goto Tcrd
  Endif
  If (Mc>290 And Mc<300) And (Mr>70 And Mr<80) And Mb=1
    Dec Count
    Goto Tcrd
  Endif
  If (Mc>260 And Mc<300) And (Mr>85 And Mr<95) And Mb=1
    Goto Bak_menu
  Endif
Loop
Bak_menu:
Goto Start_prg
Make_two:                              ! Make the second kind of card
'
'
Graphmode 1
Setcolor 0,7,7,7
Setcolor 1,5,2,3
Setcolor 15,0,0,0
Deftext 1,0,0,15
Cls
Color 1
Defline 0,3,0,0
Rbox 30,10,250,185
Defline 0,2,0,0
Line 74,10,74,185
Line 118,10,118,185
Line 162,10,162,185
Line 206,10,206,185
Defline 0,3,0,0
Line 30,39,250,39
Defline 0,2,0,0
Line 30,68,250,68
Line 30,97,250,97
Line 30,126,250,126
Line 30,155,250,155
' fill in the labels on the large card
Deftext 2,4,0,20
Restore Big_crds_lbls
For Bigx%=1 To 30
  Read Biga,Bigb,Bigc$
  If Bigx%=6 Then
    Deftext 1,0,0,4
  Endif
  Text Biga,Bigb,Bigc$
Next Bigx%
Deftext 2,0,0,4
Defline 1,1,0,0
Box 260,85,300,95
Box 260,105,300,115
Text 268,92,"DONE"
Text 268,112,"QUIT"
Deftext 2,0,0,10
Restore Mous_crd_dat
For Msrch%=1 To 50
  Read A,B,C,D,E,F,G,H
  Msa(Msrch%)=A
  Msb(Msrch%)=B
  Msc(Msrch%)=C
  Msd(Msrch%)=D
  Mse(Msrch%)=E
  Pm(Msrch%)=F
  Pcm(Msrch%)=G
  Pcmr(Msrch%)=H
Next Msrch%
'
Do
  Mouse A,B,C
  For Msrch%=1 To 50
    If (A>Msa(Msrch%) And A<Msb(Msrch%)) And (B>Msc(Msrch%) And B<Msd(Msrch%)) And C=1 Then
      P=Pm(Msrch%)
      Pc=Pcm(Msrch%)
      Pr=Pcmr(Msrch%)
      @Make_ver_crdup
      C=0
    Endif
    If (A>Msa(Msrch%) And A<Msb(Msrch%)) And (B>Msc(Msrch%) And B<Msd(Msrch%)) And C=2 Then
      P=Pm(Msrch%)
      Pc=Pcm(Msrch%)
      Pr=Pcmr(Msrch%)
      @Make_ver_crdown
      C=0
    Endif
  Next Msrch%
  If (A>260 And A<300) And (B>85 And B<95) And C=1
    Hidem
    Deffill 0,2,8
    Pbox 260,85,300,140
    Hardcopy
    Showm
    Goto Jloop
  Endif
  If (A>260 And A<300) And (B>105 And B<115) And C=1
    Goto Jloop
  Endif
Loop
Jloop:
Goto Start_prg
'
' SET ARRAYS
'
Procedure Array_set
  L$(1)="B"
  L$(2)="I"
  L$(3)="N"
  L$(4)="G"
  L$(5)="O"
  Arrayfill B(),0
  Arrayfill I(),0
  Arrayfill N(),0
  Arrayfill G(),0
  Arrayfill O(),0
  Arrayfill Bb(),0
  Arrayfill Ii(),0
  Arrayfill Nn(),0
  Arrayfill Gg(),0
  Arrayfill Oo(),0
  Arrayfill C(),0
  Cd=0
Return
'
Procedure Chk_comp_crd(Ck$)
  Deffill 10,2,8
  If Ck$="B" Then
    If Comptr1%(1,1)=N Then
      Fill 25,79
      B(1)=1
      @Snd
    Endif
    If Comptr1%(1,2)=N Then
      Fill 25,90
      B(2)=1
      @Snd
    Endif
    If Comptr1%(1,3)=N Then
      Fill 25,101
      B(3)=1
      @Snd
    Endif
    If Comptr1%(1,4)=N Then
      Fill 25,112
      B(4)=1
      @Snd
    Endif
    If Comptr1%(1,5)=N Then
      Fill 25,123
      B(5)=1
      @Snd
    Endif
    If Comptr2%(1,1)=N Then
      Fill 208,79
      Bb(1)=1
      @Snd
    Endif
    If Comptr2%(1,2)=N Then
      Fill 208,90
      Bb(2)=1
      @Snd
    Endif
    If Comptr2%(1,3)=N Then
      Fill 208,101
      Bb(3)=1
      @Snd
    Endif
    If Comptr2%(1,4)=N Then
      Fill 208,112
      Bb(4)=1
      @Snd
    Endif
    If Comptr2%(1,5)=N Then
      Fill 208,123
      Bb(5)=1
      @Snd
    Endif
  Endif
  If Ck$="I" Then
    If Comptr1%(2,1)=N Then
      Fill 41,79
      I(1)=1
      @Snd
    Endif
    If Comptr1%(2,2)=N Then
      Fill 41,90
      I(2)=1
      @Snd
    Endif
    If Comptr1%(2,3)=N Then
      Fill 41,101
      I(3)=1
      @Snd
    Endif
    If Comptr1%(2,4)=N Then
      Fill 41,112
      I(4)=1
      @Snd
    Endif
    If Comptr1%(2,5)=N Then
      Fill 41,123
      I(5)=1
      @Snd
    Endif
    If Comptr2%(2,1)=N Then
      Fill 223,79
      Ii(1)=1
      @Snd
    Endif
    If Comptr2%(2,2)=N Then
      Fill 223,90
      Ii(2)=1
      @Snd
    Endif
    If Comptr2%(2,3)=N Then
      Fill 223,101
      Ii(3)=1
      @Snd
    Endif
    If Comptr2%(2,4)=N Then
      Fill 223,112
      Ii(4)=1
      @Snd
    Endif
    If Comptr2%(2,5)=N Then
      Fill 223,123
      Ii(5)=1
      @Snd
    Endif
  Endif
  If Ck$="N" Then
    If Comptr1%(3,1)=N Then
      Fill 56,79
      N(1)=1
      @Snd
    Endif
    If Comptr1%(3,2)=N Then
      Fill 56,90
      N(2)=1
      @Snd
    Endif
    If Comptr1%(3,3)=N Then
      Fill 56,101
      N(3)=1
      @Snd
    Endif
    If Comptr1%(3,4)=N Then
      Fill 56,112
      N(4)=1
      @Snd
    Endif
    If Comptr1%(3,5)=N Then
      Fill 56,123
      N(5)=1
      @Snd
    Endif
    If Comptr2%(3,1)=N Then
      Fill 238,79
      Nn(1)=1
      @Snd
    Endif
    If Comptr2%(3,2)=N Then
      Fill 238,90
      Nn(2)=1
      @Snd
    Endif
    If Comptr2%(3,3)=N Then
      Fill 238,101
      Nn(3)=1
      @Snd
    Endif
    If Comptr2%(3,4)=N Then
      Fill 238,112
      Nn(4)=1
      @Snd
    Endif
    If Comptr2%(3,5)=N Then
      Fill 238,123
      Nn(5)=1
      @Snd
    Endif
  Endif
  If Ck$="G" Then
    If Comptr1%(4,1)=N Then
      Fill 71,79
      G(1)=1
      @Snd
    Endif
    If Comptr1%(4,2)=N Then
      Fill 71,90
      G(2)=1
      @Snd
    Endif
    If Comptr1%(4,3)=N Then
      Fill 71,101
      G(3)=1
      @Snd
    Endif
    If Comptr1%(4,4)=N Then
      Fill 71,112
      G(4)=1
      @Snd
    Endif
    If Comptr1%(4,5)=N Then
      Fill 71,123
      G(5)=1
      @Snd
    Endif
    If Comptr2%(4,1)=N Then
      Fill 253,79
      Gg(1)=1
      @Snd
    Endif
    If Comptr2%(4,2)=N Then
      Fill 253,90
      Gg(2)=1
      @Snd
    Endif
    If Comptr2%(4,3)=N Then
      Fill 253,101
      Gg(3)=1
      @Snd
    Endif
    If Comptr2%(4,4)=N Then
      Fill 253,112
      Gg(4)=1
      @Snd
    Endif
    If Comptr2%(4,5)=N Then
      Fill 253,123
      Gg(5)=1
      @Snd
    Endif
  Endif
  If Ck$="O" Then
    If Comptr1%(5,1)=N Then
      Fill 86,79
      O(1)=1
      @Snd
    Endif
    If Comptr1%(5,2)=N Then
      Fill 86,90
      O(2)=1
      @Snd
    Endif
    If Comptr1%(5,3)=N Then
      Fill 86,101
      O(3)=1
      @Snd
    Endif
    If Comptr1%(5,4)=N Then
      Fill 86,112
      O(4)=1
      @Snd
    Endif
    If Comptr1%(5,5)=N Then
      Fill 86,123
      O(5)=1
      @Snd
    Endif
    If Comptr2%(5,1)=N Then
      Fill 268,79
      Oo(1)=1
      @Snd
    Endif
    If Comptr2%(5,2)=N Then
      Fill 268,90
      Oo(2)=1
      @Snd
    Endif
    If Comptr2%(5,3)=N Then
      Fill 268,101
      Oo(3)=1
      @Snd
    Endif
    If Comptr2%(5,4)=N Then
      Fill 268,112
      Oo(4)=1
      @Snd
    Endif
    If Comptr2%(5,5)=N Then
      Fill 268,123
      Oo(5)=1
      @Snd
    Endif
  Endif
  @Full_five
Return
'
Procedure Full_five
  ' Vertical Columns Card #1
  '
  If B(1) And B(2) And B(3) And B(4) And B(5) Then
    Cd=1
    @Comp_got_bingo
  Endif
  If I(1) And I(2) And I(3) And I(4) And I(5) Then
    Cd=1
    @Comp_got_bingo
  Endif
  If N(1) And N(2) And N(4) And N(5) Then !Includes FREE
    Cd=1
    @Comp_got_bingo
  Endif
  If G(1) And G(2) And G(3) And G(4) And G(5) Then
    Cd=1
    @Comp_got_bingo
  Endif
  If O(1) And O(2) And O(3) And O(4) And O(5) Then
    Cd=1
    @Comp_got_bingo
  Endif
  ' Horizontal Columns Card #1
  '
  If B(1) And I(1) And N(1) And G(1) And O(1) Then
    Cd=1
    @Comp_got_bingo
  Endif
  If B(2) And I(2) And N(2) And G(2) And O(2) Then
    Cd=1
    @Comp_got_bingo
  Endif
  If B(3) And I(3) And G(3) And O(3) Then !Includes FREE
    Cd=1
    @Comp_got_bingo
  Endif
  If B(4) And I(4) And N(4) And G(4) And O(4) Then
    Cd=1
    @Comp_got_bingo
  Endif
  If B(5) And I(5) And N(5) And G(5) And O(5) Then
    Cd=1
    @Comp_got_bingo
  Endif
  ' Diagonal Column on B1 -- Card #1
  '
  If B(1) And I(2) And G(4) And O(5) Then
    Cd=1
    @Comp_got_bingo
  Endif
  ' Diagonal Column on O1 -- Card #1
  '
  If O(1) And G(2) And I(4) And B(5) Then
    Cd=1
    @Comp_got_bingo
  Endif
  ' Vertical Columns Card #2
  '
  If Bb(1) And Bb(2) And Bb(3) And Bb(4) And Bb(5) Then
    Cd=2
    @Comp_got_bingo
  Endif
  If Ii(1) And Ii(2) And Ii(3) And Ii(4) And Ii(5) Then
    Cd=2
    @Comp_got_bingo
  Endif
  If Nn(1) And Nn(2) And Nn(4) And Nn(5) Then !Includes FREE
    Cd=2
    @Comp_got_bingo
  Endif
  If Gg(1) And Gg(2) And Gg(3) And Gg(4) And Gg(5) Then
    Cd=2
    @Comp_got_bingo
  Endif
  If Oo(1) And Oo(2) And Oo(3) And Oo(4) And Oo(5) Then
    Cd=2
    @Comp_got_bingo
  Endif
  ' Horizontal Columns Card #2
  '
  If Bb(1) And Ii(1) And Nn(1) And Gg(1) And Oo(1) Then
    Cd=2
    @Comp_got_bingo
  Endif
  If Bb(2) And Ii(2) And Nn(2) And Gg(2) And Oo(2) Then
    Cd=2
    @Comp_got_bingo
  Endif
  If Bb(3) And Ii(3) And Gg(3) And Oo(3) Then !Includes FREE
    Cd=2
    @Comp_got_bingo
  Endif
  If Bb(4) And Ii(4) And Nn(4) And Gg(4) And Oo(4) Then
    Cd=2
    @Comp_got_bingo
  Endif
  If Bb(5) And Ii(5) And Nn(5) And Gg(5) And Oo(5) Then
    Cd=2
    @Comp_got_bingo
  Endif
  ' Diagonal Column on B1 -- Card #2
  '
  If Bb(1) And Ii(2) And Gg(4) And Oo(5) Then
    Cd=2
    @Comp_got_bingo
  Endif
  ' Diagonal Column on O1 -- Card #2
  '
  If Oo(1) And Gg(2) And Ii(4) And Bb(5) Then
    Cd=2
    @Comp_got_bingo
  Endif
Return
'
Procedure Snd
  Sound 1,15,1,5,1
  Sound 1,0
  Sound 1,15,7,7,1
  Sound 1,0
Return
'
Procedure Comp_got_bingo
  Deftext 1,4,0,6
  Deffill 0,2,8
  For Zr=1 To 10
    Sound 1,15,1,5,1
    Prbox 100,80,204,112
    Text 120,100,"!BINGO!"
    Pause 1
    Sound 1,15,7,7,1
  Next Zr
  Sound 1,0
  Leave=1
Return
'
Procedure Check_bingo
  Cls
  Graphmode 4
  Deftext 4,0,0,6
  Text 5,7,"         VERIFICATION SCREEN           "
  Graphmode 1
  Print At(2,3);"Name please: ";
  Form Input 8,Nm$
  Print At(2,5);"Enter your winning combination"
  Print At(2,6);"one part at a time. Press RETURN"
  Print At(2,7);"after each entry."
  Ck_1:
  Au=0
  Print At(2,9);"                                      "
  Print At(2,9);
  Print "First entry: ";
  Form Input 3,Fir$
  If Fir$<>"FRE" Then
    Sw$=Fir$
    @Check_ending
    If Au Then
      Goto Ck_1
    Endif
  Endif
  Ck_2:
  Au=0
  Print At(2,11);"                                      "
  Print At(2,11);
  Print "Second entry: ";
  Form Input 3,Sec$
  If Sec$<>"FRE" Then
    Sw$=Sec$
    @Check_ending
    If Au Then
      Goto Ck_2
    Endif
  Endif
  Ck_3:
  Au=0
  Print At(2,13);"                                      "
  Print At(2,13);
  Print "Third entry: ";
  Form Input 3,Thir$
  If Thir$<>"FRE" Then
    Sw$=Thir$
    @Check_ending
    If Au Then
      Goto Ck_3
    Endif
  Endif
  Ck_4:
  Au=0
  Print At(2,15);"                                      "
  Print At(2,15);
  Print "Fourth entry: ";
  Form Input 3,Fou$
  If Fou$<>"FRE" Then
    Sw$=Fou$
    @Check_ending
    If Au Then
      Goto Ck_4
    Endif
  Endif
  Ck_5:
  Au=0
  Print At(2,17);"                                      "
  Print At(2,17);
  Print "Fifth entry: ";
  Form Input 3,Fif$
  If Fif$<>"FRE" Then
    Sw$=Fif$
    @Check_ending
    If Au Then
      Goto Ck_5
    Endif
  Endif
  Print
  Print At(2,19);"Satisfied? Y/N  ";
  Form Input 1,Sati$
  If Sati$="N" Or Sati$="n" Then
    @Check_bingo
  Endif
  For J%=1 To X%
    If Fir$="FRE" Or Sv$(J%)=Fir$
      C(1)=1
    Endif
    If Sec$="FRE" Or Sv$(J%)=Sec$
      C(2)=1
    Endif
    If Thir$="FRE" Or Sv$(J%)=Thir$
      C(3)=1
    Endif
    If Fou$="FRE" Or Sv$(J%)=Fou$
      C(4)=1
    Endif
    If Fif$="FRE" Or Sv$(J%)=Fif$
      C(5)=1
    Endif
  Next J%
  If C(1)=1 And C(2)=1 And C(3)=1 And C(4)=1 And C(5)=1
    @Winner
    Yup=1
    For J%=1 To X%
      Sv$(J%)=""
    Next J%
    Win$=Nm$
    Open "o",#1,"Winner.fil"
    Write #1,Win$
    Close #1
    Pause 300
  Else
    Print
    Print "    SORRY! CARD NO GOOD"
    Pause 300
    Cls
    Sput Screen$
  Endif
Return
'
Procedure Make_ver_crdup
  Inc Ct%(P)
  If Ct%(P)=76 Then
    Text Pc,Pr,"FR"
    Goto Pv
  Endif
  If Ct%(P)=77 Then
    Ct%(P)=1
    Text Pc,Pr,"  "
  Endif
  Text Pc,Pr,Str$(Ct%(P))
  Pv:
  Pause 5
Return
'
Procedure Make_ver_crdown
  Dec Ct%(P)
  If Ct%(P)=9 Then
    Text Pc,Pr,"  "
  Endif
  If Ct%(P)=0 Then
    Text Pc,Pr,"FR"
    Goto Pvv
  Endif
  If Ct%(P)=-1 Then
    Text Pc,Pr,"  "
    Ct%(P)=75
  Endif
  Text Pc,Pr,Str$(Ct%(P))
  Pvv:
  Pause 5
Return
'
Procedure Check_ending
  If Sw$="" Then
    Print At(2,20);"You must enter something."
    Pause 100
    Print At(2,20);"                         "
    Au=1
    Goto Leave
  Endif
  If Mid$(Sw$,1,1)>"Z"
    Print At(2,20);"LOCK UPPER CASE"
    Pause 100
    Print At(2,20);"               "
    Au=1
  Endif
  If Mid$(Sw$,1,1)<>"B" And Mid$(Sw$,1,1)<>"I" And Mid$(Sw$,1,1)<>"N" And Mid$(Sw$,1,1)<>"G" And Mid$(Sw$,1,1)<>"O" Then
    Print At(2,20);"First character must be letter BINGO"
    Pause 100
    Print At(2,20);"                                    "
    Au=1
  Endif
  If (Mid$(Sw$,2,1)<"0" Or Mid$(Sw$,2,1)>"9") Then
    Print At(2,20);"2nd character must be a number"
    Pause 100
    Print At(2,20);"                                    "
    Au=1
  Endif
  If Len(Sw$)>2 Then
    If (Mid$(Sw$,3,1)<"0" Or Mid$(Sw$,3,1)>"9") Then
      Print At(2,20);"3rd character must be a number"
      Pause 100
      Print At(2,20);"                                    "
      Au=1
    Endif
  Endif
  Leave:
Return
'
Procedure Winner
  Graphmode 1
  Deffill 4,2,19
  Cls
  For Gc%=1 To 10
    Pcircle 30,50,Gc%
  Next Gc%
  Deffill 2,2,19
  For Gc%=1 To 20
    Pcircle 250,60,Gc%
  Next Gc%
  Deffill 5,2,19
  For Gc%=1 To 30
    Pcircle 50,150,Gc%
  Next Gc%
  Deffill 10,2,19
  For Gc%=1 To 25
    Pcircle 260,170,Gc%
  Next Gc%
  For Dt%=1 To 100
    Color Int(Rnd*15)+1
    R=Int(Rnd*200)+1
    C=Int(Rnd*300)+1
    Plot C,R
  Next Dt%
  Deftext 2,0,0,32
  Text 50,50,"BINGO"
  Deftext 4,0,0,32
  Text 100,100,"FOR"
  Deftext 7,0,0,32
  Text 100,150,Nm$
  Deftext 8,0,0,16
  Text 115,180,"$"+Str$(Cpz)+".00"
Return
'
' keep the old color pallett
'
Procedure Colr_get
  For I%=0 To 15
    @Vq_color(I%)
    Oldcolri(I%)=I%
    Oldcolrr(I%)=R%
    Oldcolrg(I%)=G%
    Oldcolrb(I%)=B%
  Next I%
Return
'
Procedure Vq_color(I%)
  Dpoke Contrl,26
  Dpoke Contrl+2,0
  Dpoke Contrl+4,0
  Dpoke Contrl+6,2
  Dpoke Contrl+8,0
  Dpoke Intin,I%
  Dpoke Intin+2,1
  Vdisys
  R%=Dpeek(Intout+2)
  G%=Dpeek(Intout+4)
  B%=Dpeek(Intout+6)
Return
'
' restore old colors and end
'
Finish:
For I%=0 To 15
  In%=Oldcolri(I%)
  R%=Oldcolrr(I%)
  G%=Oldcolrg(I%)
  B%=Oldcolrb(I%)
  Gosub Vr_color(In%,R%,G%,B%)
Next I%
End
'
Procedure Vr_color(In%,R%,G%,B%)
  Dpoke Contrl,14
  Dpoke Contrl+2,0
  Dpoke Contrl+6,4
  Dpoke Intin,In%
  Dpoke Intin+2,R%
  Dpoke Intin+4,G%
  Dpoke Intin+6,B%
  Vdisys
Return
'
Comp_crd1:
Data 26,80,26,91,26,102,26,113,26,124
Data 42,80,42,91,42,102,42,113,42,124
Data 57,80,57,91,57,102,57,113,57,124
Data 72,80,72,91,72,102,72,112,72,124
Data 87,80,87,91,87,102,87,113,87,124
'
Comp_crd2:
Data 209,80,209,91,209,102,209,113,209,124
Data 224,80,224,91,224,102,224,113,224,124
Data 239,80,239,91,239,102,239,113,239,124
Data 254,80,254,91,254,102,254,113,254,124
Data 269,80,269,91,269,102,269,113,269,124
'
Cdata:
Data 40,60,84,60,128,60,172,60,216,60
Data 40,89,84,89,128,89,172,89,216,89
Data 40,118,84,118,128,118,172,118,216,118
Data 40,147,84,147,128,147,172,147,216,147
Data  40,176,84,176,128,176,172,176,216,176
'
Small_crds:
Data 23,57,100,128,23,72,100,72,23,83,100,83,23,94,100,94,23,105,100,105,23,116,100,116
Data 39,57,39,128,54,57,54,128,69,57,69,128,84,57,84,128
Data 205,57,282,128,205,72,282,72,205,83,282,83,205,94,282,94,205,105,282,105,205,116,282,116
Data 221,57,221,128,236,57,236,128,251,57,251,128,266,57,266,128
'
Big_crds_lbls:
Data 40,32,"B",85,32,"I",130,32,"N",175,32,"G",220,32,"O"
Data 60,46,"B1",104,46,"I1",148,46,"N1",192,46,"G1",236,46,"O1"
Data 60,74,"B2",104,74,"I2",148,74,"N2",192,74,"G2",236,74,"O2"
Data 60,103,"B3",104,103,"I3",148,103,"N3",192,103,"G3",236,103,"O3"
Data 60,132,"B4",104,132,"I4",148,132,"N4",192,132,"G4",236,132,"O4"
Data 60,161,"B5",104,161,"I5",148,161,"N5",192,161,"G5",236,161,"O5"
'
Mous_crd_dat:
Data 33,72,41,66,1,1,40,60,33,72,41,66,2,1,40,60
Data 76,115,41,66,1,2,84,60,76,115,41,66,2,2,84,60
'
Data 121,159,41,66,1,3,128,60,121,159,41,66,2,3,128,60
Data 163,203,41,66,1,4,172,60,163,203,41,66,2,4,172,60
'
Data 207,244,41,66,1,5,216,60,207,244,41,66,2,5,216,60
Data 33,71,70,94,1,6,40,89,33,71,70,94,2,6,40,89
'
Data 75,113,70,94,1,7,84,89,75,113,70,94,2,7,84,89
Data 119,159,70,94,1,8,128,89,119,159,70,94,2,8,128,89
'
Data 164,202,70,94,1,9,172,89,164,202,70,94,2,9,172,89
Data 208,254,70,94,1,10,216,89,208,254,70,94,2,10,216,89
'
Data 33,70,99,123,1,11,40,118,33,70,99,123,2,11,40,118
Data 77,114,99,123,1,12,84,118,77,114,99,123,2,12,84,118
'
Data 119,158,99,123,1,13,128,118,119,158,99,123,2,13,128,118
Data 163,205,99,123,1,14,172,118,163,205,99,123,2,14,172,118
'
Data 208,244,99,123,1,15,216,118,208,244,99,123,2,15,216,118
Data 33,70,128,153,1,16,40,147,33,70,128,153,2,16,40,147
'
Data 76,114,128,153,1,17,84,147,76,114,128,153,2,17,84,147
Data 119,158,128,153,1,18,128,147,119,158,128,153,2,18,128,147
'
Data 164,203,128,153,1,19,172,147,164,203,128,153,2,19,172,147
Data 208,244,128,153,1,20,216,147,208,244,128,153,2,20,216,147
'
Data 33,70,157,181,1,21,40,176,33,70,157,181,2,21,40,176
Data 75,114,157,181,1,22,84,176,75,114,157,181,2,22,84,176
'
Data 119,157,157,181,1,23,128,176,119,157,157,181,2,23,128,176
Data 163,204,157,181,1,24,172,176,163,204,157,181,2,24,172,176
'
Data 208,244,157,181,1,25,216,176,208,244,157,181,2,25,216,176
