'
' Sounds-A-Like
' Atari ST Computers
' Gfa Basic
' August 1988
'
Dim Oldcolri(15),Oldcolrr(15),Oldcolrg(15),Oldcolrb(15)
Dim N(4,4),G(2)
Cls
Gosub Colr_get
Oldscore=0
Start:
Hidem
Gosub Ld_screen
Gosub Rand_sel
Deffill 0,1
Score=0
Acu=0
Count=0
Fl1=0
Fl2=0
Fl3=0
Fl4=0
Fl5=0
Fl6=0
Fl7=0
Fl8=0
Fl9=0
Fl10=0
Fl11=0
Fl12=0
Fl13=0
Fl14=0
Fl15=0
Fl16=0
Print At(34,11);"0 "
Print At(34,13);"0 "
Print At(35,19);"0 "
Print At(35,16);"0 "
Print At(28,22);"            "
Print At(28,24);"            "
Defline 1,3,0,0
Showm
Deftext 1,0,0,4
Color 2
Rbox 233,170,293,187
Print At(31,23);"Start"
Wave 8,3,8,1000,10
Wave 0,0
Info$="      SOUNDS-A-LIKE|  By A. Baggetta  v.1.0       |         "+Chr$(189)+" 1988         |    Atari ST Computers  "
Repeat
  Mouse A,B,C
  A=Int(A/8)+1
  B=Int(B/8)+1
  If C=2
    Alert 0,Info$,1,"Ok!",Bbb
  Endif
Until A=31 Or A=32 Or A=33 Or A=34 Or A=35 And B=23 And C=1
Wave 8,3,8,1000,10
Wave 0,0
Color 0
Rbox 233,170,293,187
Print At(31,23);"     "
Color 1
Print At(30,22);"Expert"
Print At(30,24);"Beginner"
Do
  Mouse A,B,C
  A=Int(A/8)+1
  B=Int(B/8)+1
  If A=30 Or A=31 Or A=32 Or A=33 Or A=34 Or A=35 And B=22 And C=1
    Alot=50
    Goto Elop
  Endif
  If A=30 Or A=31 Or A=32 Or A=33 Or A=34 Or A=35 Or A=36 Or A=37 And B=24 And C=1
    Alot=100
    Goto Elop
  Endif
Loop
Elop:
Print At(30,22);"      "
Print At(30,24);"        "
Wave 8,3,8,1000,10
Wave 0,0
Tmr=Timer
Print At(34,11);Alot
While Acu<>8
  Count=Count+1
  Print At(35,16);Count
  F1=0
  F2=0
  F3=0
  F4=0
  F5=0
  F6=0
  F7=0
  F8=0
  F9=0
  F10=0
  F11=0
  F12=0
  F13=0
  F14=0
  F15=0
  F16=0
  T=1
  For Guess=1 To 2
    Print At(28,22);"GUESS ";T
    Over:
    E=0
    Do
      Mouse A,B,C
      A=Int(A/8)+1
      B=Int(B/8)+1
      Z=Int((Timer-Tmr)/2)/100
      Exit If Int(Z)=>Alot Or C=1
    Loop
    Print At(34,13);Int(Z);" "
    Exit If T>2 Or Int(Z)=>Alot
    Print At(28,22);"GUESS ";T
    If A=1 And B=9 And C=1 And F1=0 And Fl1=0
      On N(1,1) Gosub S1,S2,S3,S4,S5,S6,S7,S8
      G(T)=N(1,1)
      F1=1
      T=T+1
      E=1
    Endif
    If A=8 And B=9 And C=1 And F2=0 And Fl2=0
      On N(1,2) Gosub S1,S2,S3,S4,S5,S6,S7,S8
      G(T)=N(1,2)
      F2=1
      T=T+1
      E=1
    Endif
    If A=14 And B=9 And C=1 And F3=0 And Fl3=0
      On N(1,3) Gosub S1,S2,S3,S4,S5,S6,S7,S8
      G(T)=N(1,3)
      F3=1
      T=T+1
      E=1
    Endif
    If A=21 And B=9 And C=1 And F4=0 And Fl4=0
      On N(1,4) Gosub S1,S2,S3,S4,S5,S6,S7,S8
      G(T)=N(1,4)
      F4=1
      T=T+1
      E=1
    Endif
    If A=1 And B=14 And C=1 And F5=0 And Fl5=0
      On N(2,1) Gosub S1,S2,S3,S4,S5,S6,S7,S8
      G(T)=N(2,1)
      F5=1
      T=T+1
      E=1
    Endif
    If A=8 And B=14 And C=1 And F6=0 And Fl6=0
      On N(2,2) Gosub S1,S2,S3,S4,S5,S6,S7,S8
      G(T)=N(2,2)
      F6=1
      T=T+1
      E=1
    Endif
    If A=14 And B=14 And C=1 And F7=0 And Fl7=0
      On N(2,3) Gosub S1,S2,S3,S4,S5,S6,S7,S8
      G(T)=N(2,3)
      F7=1
      T=T+1
      E=1
    Endif
    If A=21 And B=14 And C=1 And F8=0 And Fl8=0
      On N(2,4) Gosub S1,S2,S3,S4,S5,S6,S7,S8
      G(T)=N(2,4)
      F8=1
      T=T+1
      E=1
    Endif
    If A=1 And B=19 And C=1 And F9=0 And Fl9=0
      On N(3,1) Gosub S1,S2,S3,S4,S5,S6,S7,S8
      G(T)=N(3,1)
      F9=1
      T=T+1
      E=1
    Endif
    If A=8 And B=19 And C=1 And F10=0 And Fl10=0
      On N(3,2) Gosub S1,S2,S3,S4,S5,S6,S7,S8
      G(T)=N(3,2)
      F10=1
      T=T+1
      E=1
    Endif
    If A=14 And B=19 And C=1 And F11=0 And Fl11=0
      On N(3,3) Gosub S1,S2,S3,S4,S5,S6,S7,S8
      G(T)=N(3,3)
      F11=1
      T=T+1
      E=1
    Endif
    If A=21 And B=19 And C=1 And F12=0 And Fl12=0
      On N(3,4) Gosub S1,S2,S3,S4,S5,S6,S7,S8
      G(T)=N(3,4)
      F12=1
      T=T+1
      E=1
    Endif
    If A=1 And B=24 And C=1 And F13=0 And Fl13=0
      On N(4,1) Gosub S1,S2,S3,S4,S5,S6,S7,S8
      G(T)=N(4,1)
      F13=1
      T=T+1
      E=1
    Endif
    If A=8 And B=24 And C=1 And F14=0 And Fl14=0
      On N(4,2) Gosub S1,S2,S3,S4,S5,S6,S7,S8
      G(T)=N(4,2)
      F14=1
      T=T+1
      E=1
    Endif
    If A=14 And B=24 And C=1 And F15=0 And Fl15=0
      On N(4,3) Gosub S1,S2,S3,S4,S5,S6,S7,S8
      G(T)=N(4,3)
      F15=1
      T=T+1
      E=1
    Endif
    If A=21 And B=24 And C=1 And F16=0 And Fl16=0
      On N(4,4) Gosub S1,S2,S3,S4,S5,S6,S7,S8
      G(T)=N(4,4)
      F16=1
      T=T+1
      E=1
    Endif
    If E=0
      Goto Over
    Endif
  Next Guess
  Exit If Int(Z)=>Alot
  Print At(28,22);"         "
  If G(1)=G(2)
    For Rpt=1 To 3
      Print At(28,24);"Match!!  "
      Sound 1,10,1,6,5
      Print At(28,24);"         "
      Sound 1,10,1,4,5
    Next Rpt
    Sound 1,0,0,0,0
    Score=Score+10
    If Score<0
      Score=0
    Endif
    Print At(35,19);Int(Score)
    Gosub Match_chk
  Else
    For Rpt=1 To 3
      Print At(28,24);"No Match!"
      Sound 1,10,1,2,5
      Print At(28,24);"         "
      Sound 1,10,1,1,5
      Gosub Nomatch_chk
    Next Rpt
    Sound 1,0,0,0,0
    Score=Score-(Int(Z)/50)
    If Score<0
      Score=0
    Endif
    Print At(35,19);Int(Score)
  Endif
Wend
'
' put in a routine for timer here
' erase screen etc.
'
Print At(28,22);"         "
Pbox 1,52,201,196
Defline 6,2,0,0
Rbox 1,52,201,196
Deftext 2,16,0,6
Text 55,70,"GAME OVER"
'
' End Sound
'
For Drop=5 To 1 Step -1
  Sound 1,9,5,2,2
  Sound 2,10,Drop,5,2
Next Drop
Sound 1,0,0,0,0
Sound 2,0,0,0,0
If Int(Z)=>Alot
  Print At(4,12);"You ran out of time!"
Else
  Print At(4,12);"You beat the clock!!"
Endif
Print At(4,13);"--------------------"
Print At(4,15);"Your old Score > ";Int(Oldscore)
Print At(4,17);"Current  Score > ";Int(Score)
Print At(4,19);"You played for:"
Print At(6,21);Int(Z);" seconds"
Oldscore=Score
Print At(28,24);"Again?  Y/N"
Do
  Mouse A,B,C
  A=Int(A/8)+1
  B=Int(B/8)+1
  If A=36 And B=24 And C=1
    Wave 8,3,8,1000,10
    Wave 0,0
    Goto Start
  Endif
  If A=38 And B=24 And C=1
    Wave 8,3,8,1000,10
    Wave 0,0
    Goto Finish
  Endif
Loop
' sound voice, volume, note, octave, duration
' wave  voice, envelope, form, length, duration
'
Procedure S1
  Text 215,140,"Whoopie!"
  For I=1 To 9
    Sound 1,10,I,5,1
  Next I
  For I=9 Downto 1
    Sound 1,10,I,5,1
  Next I
  Sound 1,0,0,0,0
  Text 215,140,"         "
Return
'
Procedure S2
  ' space sound
  Text 215,140,"Warp Zone!"
  Sound 1,15,1,3
  Wave 1,1,12,90,0
  Pause 100
  Wave 1,0
  Sound 1,0
  Text 215,140,"          "
Return
'
Procedure S3
  Text 215,140,"Buzzer"
  Sound 1,10,9,5,0
  Wave 1,1,8,50,25
  Sound 1,0,0,0,0
  Text 215,140,"      "
Return
'
Procedure S4
  Text 215,140,"Woodpecker"
  Sound 1,10,5,5,0
  Wave 1,1,8,200,25
  Sound 1,0,0,0,0
  Text 215,140,"          "
Return
'
Procedure S5
  Text 215,140,"Laser Gun"
  For I=1 To 15
    Wave 8,1,8,I,1
  Next I
  Wave 0,0
  Text 215,140,"         "
Return
'
Procedure S6
  ' air
  Text 215,140,"Air Leak"
  Wave 16,2,0,40000,3
  Pause 50
  Wave 0,0
  Text 215,140,"        "
Return
'
Procedure S7
  Text 215,140,"Spinner"
  For I=5 Downto 1
    Sound 1,10,5,5,I
    Sound 1,10,4,5,I
    Sound 1,10,3,5,I
    Sound 1,10,2,5,I
  Next I
  Sound 1,0,0,0,0
  Text 215,140,"       "
Return
'
Procedure S8
  ' chime
  Text 215,140,"chime"
  Sound 1,15,8,5
  Wave 1,3,0,30000,8
  Text 215,140,"     "
Return
' *****************************
' Ld Degas Screen
' *****************************
Procedure Ld_screen
  Res=Xbios(4)
  Open "I",#1,"a:tapescrn.PI1"
  Y=Inp(#1)
  X=Inp(#1)
  If X<>Res
    Alert 1," Wrong resolution ",1,"okay",Dummy
    End
  Endif
  For N=0 To 15
    X=Inp(#1)
    Y=Inp(#1)
    Z=X*256+Y
    C=Xbios(7,N,Z)
  Next N
  Seek #1,34
  Bget #1,Xbios(2),32000
  Close #1
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
' *********************************
' Random Selection
' *********************************
Procedure Rand_sel
  Ct1=0
  Ct2=0
  Ct3=0
  Ct4=0
  Ct5=0
  Ct6=0
  Ct7=0
  Ct8=0
  For R=1 To 4
    For C=1 To 4
      K=0
      Repeat
        X=Int(Rnd*8)+1
        If Ct1<>2 And X=1
          N(R,C)=X
          Ct1=Ct1+1
          K=1
        Endif
        If Ct2<>2 And X=2
          N(R,C)=X
          Ct2=Ct2+1
          K=1
        Endif
        If Ct3<>2 And X=3
          N(R,C)=X
          Ct3=Ct3+1
          K=1
        Endif
        If Ct4<>2 And X=4
          N(R,C)=X
          Ct4=Ct4+1
          K=1
        Endif
        If Ct5<>2 And X=5
          N(R,C)=X
          Ct5=Ct5+1
          K=1
        Endif
        If Ct6<>2 And X=6
          N(R,C)=X
          Ct6=Ct6+1
          K=1
        Endif
        If Ct7<>2 And X=7
          N(R,C)=X
          Ct7=Ct7+1
          K=1
        Endif
        If Ct8<>2 And X=8
          N(R,C)=X
          Ct8=Ct8+1
          K=1
        Endif
      Until K=1
    Next C
  Next R
Return
'
'
Procedure Nomatch_chk
  If F1=1
    F1=0
  Endif
  If F2=1
    F2=0
  Endif
  If F3=1
    F3=0
  Endif
  If F4=1
    F4=0
  Endif
  If F5=1
    F5=0
  Endif
  If F6=1
    F6=0
  Endif
  If F7=1
    F7=0
  Endif
  If F8=1
    F8=0
  Endif
  If F9=1
    F9=0
  Endif
  If F10=1
    F10=0
  Endif
  If F11=1
    F11=0
  Endif
  If F12=1
    F12=0
  Endif
  If F13=1
    F13=0
  Endif
  If F14=1
    F14=0
  Endif
  If F15=1
    F15=0
  Endif
  If F16=1
    F16=0
  Endif
Return
'
'
Procedure Match_chk
  If F1=1
    Fl1=1
    Pbox 1,52,43,81
    Wave 8,3,8,1000,10
    Wave 0,0
  Endif
  If F2=1
    Fl2=1
    Pbox 53,53,96,81
    Wave 8,3,8,1000,10
    Wave 0,0
  Endif
  If F3=1
    Fl3=1
    Pbox 106,53,148,81
    Wave 8,3,8,1000,10
    Wave 0,0
  Endif
  If F4=1
    Fl4=1
    Pbox 158,53,201,81
    Wave 8,3,8,1000,10
    Wave 0,0
  Endif
  If F5=1
    Fl5=1
    Pbox 1,92,44,120
    Wave 8,3,8,1000,10
    Wave 0,0
  Endif
  If F6=1
    Fl6=1
    Pbox 53,92,96,120
    Wave 8,3,8,1000,10
    Wave 0,0
  Endif
  If F7=1
    Fl7=1
    Pbox 106,92,149,120
    Wave 8,3,8,1000,10
    Wave 0,0
  Endif
  If F8=1
    Fl8=1
    Pbox 158,92,201,120
    Wave 8,3,8,1000,10
    Wave 0,0
  Endif
  If F9=1
    Fl9=1
    Pbox 1,129,44,157
    Wave 8,3,8,1000,10
    Wave 0,0
  Endif
  If F10=1
    Fl10=1
    Pbox 53,129,96,157
    Wave 8,3,8,1000,10
    Wave 0,0
  Endif
  If F11=1
    Fl11=1
    Pbox 106,129,149,157
    Wave 8,3,8,1000,10
    Wave 0,0
  Endif
  If F12=1
    Fl12=1
    Pbox 158,129,201,157
    Wave 8,3,8,1000,10
    Wave 0,0
  Endif
  If F13=1
    Fl13=1
    Pbox 1,168,44,196
    Wave 8,3,8,1000,10
    Wave 0,0
  Endif
  If F14=1
    Fl14=1
    Pbox 53,168,96,196
    Wave 8,3,8,1000,10
    Wave 0,0
  Endif
  If F15=1
    Fl15=1
    Pbox 106,168,149,196
    Wave 8,3,8,1000,10
    Wave 0,0
  Endif
  If F16=1
    Fl16=1
    Pbox 158,168,201,196
    Wave 8,3,8,1000,10
    Wave 0,0
  Endif
  Acu=Acu+1
Return