Screen Open 0,320,200,2,Lowres
Curs Off : Cls 0 : Hide : Change Mouse 2
Dim NSF(3),AFS(3),HF(9,14),SNAME$(10),SCORE$(10),SNAME2$(40),SCORE2$(40)
Global NSF(),AFS(),HF(),SNAME$(),SCORE$(),SNAME2$(),SCORE2$(),SC,SC2,ML,SANZ,SOC,Q,M2$,SCOK
BILDIMRAM
For I=1 To 3 : AFS(I)=Rnd(8)+1 : Next I
PROGRAMM:
FRAGE
Unpack 15 To 0 : Screen Hide 
NEHMEGRAFIK
NAECHSTERSTEIN
Ink 1,0 : Text 84,178,Upper$(M$)
If SANZ=4 Then M2$=SCORE2$(1) : NHL=2
If SANZ=5 Then M2$=SCORE2$(11) : NHL=1
If SANZ=7 Then M2$=SCORE2$(21) : NHL=0
If M$="Hundred" Then M2$=SCORE2$(31) : NHL=2 : TEH=True : AEH=0
Text 140-Len(M2$)*8,110,M2$
Screen Clone 1 : Screen To Front 0
Fade 1 : Wait 16 : Auto View Off : Screen Show 
For X=0 To 31 : Colour X,0 : Next 
View : Auto View On : Fade 4 To 1 : Screen Close 1 : Wait Vbl : Wait 20
A$=" SPHERIX WAS PROGRAMMED BY VOLKER STEPPRATH IN 1991 FOR DEPECHE SOFTWARE "
A$=A$+"..... GREATINGS GOES TO FRANCOIS, SABINE, HARALD, FRANK, JORK, KARSTEN, LITTLE KAI AND MAMA ..... "
A$=A$+"GAMERULES: ..... YOU'VE ALWAYS TO TRY LEAST THEN 3 OF THE SAME COLORS IN HORIZONTAL OR VERTICAL LINE. "
A$=A$+"IF THERE ARE MORE THEN 5 COLORS OR A CHAIN REACTION IN THIS ORDER, THE BOTTOM LINE WILL COMPLETLY DISAPPEAR ! "
A$=A$+"AT ANY TIME YOU MAKE AN IMAGINE MOVE OR ERASE ALL STONES YOU WILL ENTER THE BONUS-ROUND ! "
A$=A$+"IF YOU WANT TO SWAP THE SEQUENCE OF THE FALLING STONES, PRESS THE FIREBUTTON AND SELECT HOW DO YOU NEED ! "
A$=A$+"REMEMBER ..... IF YOU HAVE PLACED MORE THEN 3 STONES WITHOUT ANY EFFECT, EVERY ONE STEPS ONE TO THE TOP ! "
A$=A$+"..... VERY EASY ISN'T IT ..... SOME NOTES: ..... SPHERIX IS PUBLIC DOMAIN AND WAS WRITTEN FOR THOSE WHO HAVE (HAD) NOT ENOUGH MONEY "
A$=A$+"FOR COLORIS OR ANY ELSE LIKE THIS ! ..... SURE SPHERIX ISN'T A FULL PROFESSIONAL SUBSTITUTE, "
A$=A$+"BUT I'LL HOPE YOU LIKE IT. ..... THAT'S ALL ..... NOW PRESS FIRE TO CONTINUE ..... CIAO .....                  "
LAUFSCHRIFT[A$]
If M$="Hundred" Then Text 47,222,"Stone #000"
Sam Play 5,5,12000 : Wait 80 : Def Scroll 1,168,45 To 294,227,0,-14 : SC2=0
Do 
  NAECHSTERSTEIN
  X=4 : Y=31 : HI=True : I=1 : I2=0
  If TEH=True : Inc AEH : Ink 1 : Text 103,222,String$("0",3-Len(Str$(AEH)-" "))+Str$(AEH)-" " : End If 
  Repeat 
    Add Y,1
    If HI Then Wait Vbl 
    If Fire(1) and HI Then Bob Off I : Add I,1,1 To 3 : Bob I,168+X*14,Y,I : Swap NSF(1),NSF(2) : Swap NSF(2),NSF(3) : Wait 2
    If Jright(1) and X<8 and HI Then ZUGRECHTS[X,Y] : Wait Vbl 
    If Jleft(1) and X>0 and HI Then ZUGLINKS[X,Y] : Wait Vbl 
    If Jdown(1) Then HI=False
    If Jup(1) Then HI=True
    Bob I,168+(X*14),Y,I : If HI Then Wait Vbl 
  Until Point(175+X*14,Y+42)<>0
  Bob Off I : Wait Vbl 
  For I=1 To 3 : Put Block NSF(I),168+(X*14),(I-1)*14+(Y/14*14)+3 : Next I
  Inc ML
  TESTMAIN[X,Y,SPF,SP]
  If ML>2
    Scroll 1 : Ink 0 : Bar 168,213 To 293,226
    For I=1 To 9
      For I2=2 To 13
        HF(I,I2)=HF(I,I2+1)
      Next I2
    Next I
    For I=0 To 8
      If HF(1+I,14)>0 : Put Block 10,168+I*14,213 : HF(1+I,14)=1000 : End If 
    Next I
    ML=NHL
  End If 
  For I=1 To 9 : Exit If HF(I,4) or AEH=100,2 : Next I : I2=0
  For I=1 To 9 : If HF(I,14)=0 Then Inc I2 : Next I
  If I2=9 or SC2=True Then Gosub BONUSRUNDE
Loop 
ML=0 : Ink 1,0 : Gr Writing 0 : Sam Play 6,6,14000
If TEH=True and AEH=100
  Text 175,55,"Game Completed"
  A$=" GAME OVER ..... YOU'VE PLACED EVERYONE OF HUNDRED STONES ..... PRESS FIRE TO CONTINUE ....."
Else 
  Text 197,55,"Game Over" : Draw 168,86 To 293,86
  A$=" GAME OVER ..... YOU CROSSED THE TOP OF LINE ..... PRESS FIRE TO CONTINUE ....."
End If 
LAUFSCHRIFT[A$]
Ink 0 : TEH=False : AEH=0
For I=12 To 234 Step 2 : Draw 5,I To 310,I : Draw 5,247-I To 310,247-I : Wait Vbl : Next I
SCOREZEIGEN[M$]
Goto PROGRAMM
BONUSRUNDE:
  If SC2=True
    Get Cblock 15,168,86,132,141
    A2$="THIS WAS A VERY IMAGINABLE MOVE ..... "
    Ink 0 : Bar 168,80 To 293,226
  Else 
    A2$="YOU ERASED ALL STONES ..... "
  End If 
  Ink 1,0 : Text 187,55,"BONUS-ROUND" : Text 171,64,"move your stick" : Draw 168,86 To 293,86 : I3=1
  For I=1 To 14
    I2=85-(I*5+5) : Inc I3 : If I3=14 Then Add I3,6
    Ink I3 : Text 171,85+I*10,Str$(I2)-" "+Space$(10)+Str$(I2)
  Next I
  Put Block 11,211,220
  A$=" WELL DONE ..... "+A2$+"FOR THIS YOU ENTERED THE BONUS-ROUND ..... NOW TORTURE YOUR STICK FOR HEAVY POINTS ....."
  LAUFSCHRIFT[A$]
  I=220 : RE=-1 : Z=0 : I2=0 : Ink 1,0 : Sam Play 5,5,12000 : Wait 80
  Every 300 Gosub ZEIT : Every On 
  Repeat 
    If Jleft(1) and R=True : I=I+(I>90)*4 : R=False : Else I=I-(I<>220) : End If 
    Gosub PBONUS
    If Jright(1) and R=False : I=I+(I>90)*4 : R=True : Else I=I-(I<>220) : End If 
    Gosub PBONUS
  Until Z
  Every Off : Boom 
  I=(220-I)/10*10 : I=((230-(220-I))/2+5)*100 : I2=I/100 : SC=SC+I : SC$=Str$(SC)-" "
  Text 140-Len(SC$)*8,144,SC$
  If SC>Val(M2$) Then Text 140-Len(SC$)*8,110,SC$
  A$=" YOUR BONUS-SCORE IS"+Str$(I2)+" x"+" 100"+" ="+Str$(I)+" POINTS ..... NOW GO ON IN THE MAINGAME ....."
  LAUFSCHRIFT[A$]
  Ink 0 : Bar 168,32 To 293,226 : If SC2=True Then Put Cblock 15,168,86 : Wait Vbl : Del Cblock 15 : SC2=False
  If TEH=True : Ink 1 : Text 47,222,"Stone #"+String$("0",3-Len(Str$(AEH)-" "))+Str$(AEH)-" " : End If 
  Sam Play 5,5,12000 : Wait 80
Return 
PBONUS:
  Put Block 11,211,I : For I2=1 To 400 : Next I2
Return 
ZEIT:
  Inc Z
Return 
Procedure ZUGRECHTS[X,Y]
If Point(189+X*14,Y+43)<>0 Then Pop Proc
Shared X
X2=X+1 : Y2=(Y-31)/14 : Y2=Y2*14/14+2
If Y2>14 Then Y2=14
Add Y2,-3
For I=1 To 3 : Swap HF(X2,Y2+I),HF(X2+1,Y2+I) : Next I
Inc X
If X>8 Then X=8
End Proc
Procedure ZUGLINKS[X,Y]
If Point(161+X*14,Y+43)<>0 Then Pop Proc
Shared X
X2=X : Y2=(Y-31)/14 : Y2=Y2*14/14+2
If Y2>14 Then Y2=14
Add Y2,-3
For I=1 To 3 : Swap HF(X2,Y2+I),HF(X2+1,Y2+I) : Next I
Dec X
If X<0 Then X=0
End Proc
Procedure TESTMAIN[X,Y,SPF,SP]
Sam Play SP,SP,SPF
Y=(Y-31)/14 : Y=Y*14/14
Add X,1
For I=1 To 3
  HF(X,Y+I)=NSF(I)
Next I
Repeat 
TEST=False
For I=1 To 9
  For I2=1 To 14
    If HF(I,I2)<>0 and HF(I,I2)<1000
      N$=Right$(Str$(HF(I,I2)),1) : Y2=0 : I3=I2
      For II=I2 To 14
        If Right$(Str$(HF(I,II)),1)=N$
          Add Y2,1
        Else 
          II=14
        End If 
      Next II
      If Y2>2
        TEST=True
        For II=I3 To I3+Y2-1
           HF(I,II)=10+Val(N$)
        Next II
        Y2=0
      End If 
      Y2=0
    End If 
    Y2=0
  Next I2
Next I
For I=3 To 14
  For I2=1 To 9
    If HF(I2,I)<>0 and HF(I2,I)<1000
      N$=Right$(Str$(HF(I2,I)),1) : Y2=0 : I3=I2
      For II=I2 To 9
        If Right$(Str$(HF(II,I)),1)=N$
          Add Y2,1
        Else 
          II=9
        End If 
      Next II
      If Y2>2
        TEST=True
        For II=I3 To I3+Y2-1
          HF(II,I)=10+Val(N$)
        Next II
        Y2=0
      End If 
      Y2=0
    End If 
    Y2=0
  Next I2
Next I
N$=""
If TEST=True
  Ink 0
  For I=1 To 9
    For I2=1 To 14
      If HF(I,I2)>9 and HF(I,I2)<1000
        HF(I,I2)=0 : Add Y2,1
        Bar 168+(I-1)*14,31+(I2-1)*14 To 167+I*14,30+I2*14
      End If 
    Next I2
  Next I
  ZEIGESCORE[Y2,RUT]
  Ink 0 : Y2=0
  For I=1 To 9
    For I2=14 To 1 Step -1
      If HF(I,I2)=<0 and HF(I,I2-1)>0 and HF(I,I2)<1000
        I4=I2
        Swap HF(I,I4),HF(I,I4-1)
        BN=HF(I,I4)
        If BN>9 : Add BN,-10 : End If 
        Bar 168+(I-1)*14,31+(I4-2)*14 To 167+I*14,31+(I4-1)*14
        If BN>500 : BN=10 : End If 
        Put Block BN,168+(I-1)*14,31+(I4-1)*14
        Add I4,-1
        KL=True
      End If 
    Next I2
    If KL=True : Sam Play SP,SP,SPF : Wait 3 : Dec I : KL=False : End If 
  Next I
End If 
RUT=True
Until TEST=False
RUT=False
End Proc
Procedure TAUSCHSTEIN
  Swap NSF(1),NSF(2) : Swap NSF(2),NSF(3)
  While Fire(1)<>0 : Wend 
End Proc
Procedure NAECHSTERSTEIN
Randomize Timer
Ink 0 : Bar 135,31 To 152,72
For I=1 To 3
  NSF(I)=AFS(I) : AFS(I)=Rnd(SANZ)+1
  Put Block NSF(I),141,(I-1)*14+31
Next I
For I=1 To 3
  Get Bob I,141,31 To 155,73
  Swap NSF(1),NSF(2) : Swap NSF(2),NSF(3)
  For I2=1 To 3 : Put Block NSF(I2),141,(I2-1)*14+31 : Next I2
Next I
For I=1 To 3 : Put Block AFS(I),141,(I-1)*14+31 : Next I
End Proc
Procedure NEHMEGRAFIK
For I=0 To 8 : Get Block 1+I,177+SOC,38+I*14,14,14,1 : Next I
Get Block 10,177+SOC,150,14,14,1
Get Block 11,177,164,42,7,1
Ink 0 : Bar 177,38 To 240,200
End Proc
Procedure LAUFSCHRIFT[A$]
While Fire(1)=True : Wend 
Def Scroll 16,15,213 To 161,225,-1,0 : Ink 1,0
Repeat 
If A=0
  Text 152,222,Mid$(A$,EXT,1)
  Inc EXT
  If EXT>Len(A$) : EXT=1 : End If 
End If 
Wait Vbl : Scroll 16 : Inc A
If A=8 : A=0 : End If 
Until Fire(1)=True
For I=1 To 146 : Wait Vbl : Scroll 16 : Next I
End Proc
Procedure ZEIGESCORE[Y2,RUT]
If Y2>3 Then Y2=Y2*10
Add SC,Y2 : ML=0
If Y2>50 or RUT=True
  If SANZ=4 and Y2>80 : SC2=True : End If 
  If SANZ=5 and Y2>70 : SC2=True : End If 
  If SANZ=7 and Y2>60 : SC2=True : End If 
  For I=1 To 9 : HF(I,14)=0 : Next I
  Bar 168,213 To 293,226 : Y2=Y2*10 : Add SC,Y2
End If 
Ink 1,0 : SC$=Str$(SC)-" " : Text 140-Len(SC$)*8,144,SC$
If SC>Val(M2$) Then Text 140-Len(SC$)*8,110,SC$
End Proc
Procedure BILDIMRAM
Open In 1,"score.dat"
  For I=1 To 40
    Input #1,SNAME2$(I)
    Input #1,SCORE2$(I)
  Next I
Close 1
Wait 130 : Fade 1 : Wait 16
Auto View Off 
Unpack 12 To 0 : Screen Clone 1 : Screen To Front 0
For X=0 To 31 : Colour X,0 : Next 
View : Auto View On : Fade 3 To 1 : Screen Close 1 : Wait Vbl : Music 1 : Wait 300
Music Stop : Erase 3 : Erase 12
Fade 3 : Wait 50 : Cls 0
End Proc
Procedure FRAGE
Shared M$,SPF,SP
Unpack 13 To 0 : Screen Hide 
Get Block 1,35,198,91,15,1 : Get Block 2,34,213,91,15,1
Ink 0 : Bar 34,195 To 230,240
SANZ=4 : M$="Easy   " : SOC=0 : X=194 : Y=91 : AA=1 : AA2=1 : A=1 : A2=1 : SPF=9000
Put Block 1,66,97 : Put Block 1,166,97
Screen Show 
Screen Open 1,320,220,8,Lowres
Cls 0 : Get Palette 0
For I=1 To 97 : Screen Copy 0,157-I,138-I,167+I,90+I To 1,157-I,130-I : Wait Vbl : Next I
Screen To Front 0 : Screen Close 1
X Mouse=194 : Y Mouse=91 : Show 
Do 
  Repeat 
    If Jleft(1) Then Add X,-2,192 To 384
    If Jright(1) Then Add X,2,192 To 384
    If Jdown(1) Then Add Y,2,90 To 229
    If Jup(1) Then Add Y,-2,90 To 229
    X Mouse=X : Y Mouse=Y : Wait 1
  Until Fire(1)
  If X<284 and Y>139 and Y<196
    If Y>139 and Y<153 : A=1 : SOC=0 : SPF=9000 : End If 
    If Y>154 and Y<165 : A=2 : SOC=14 : SPF=15000 : End If 
    If Y>167 and Y<180 : A=3 : SOC=28 : SPF=20500 : End If 
    If Y>183 and Y<194 : A=4 : SOC=42 : SPF=20000 : End If 
    Put Block 2,66,83+AA*15-AA
    Put Block 1,66,83+A*15-A : AA=A
  End If 
  If X>296 and Y>139 and Y<196
    If Y>139 and Y<153 : A2=1 : SANZ=4 : M$="Easy   " : End If 
    If Y>154 and Y<165 : A2=2 : SANZ=5 : M$="Medium " : End If 
    If Y>167 and Y<180 : A2=3 : SANZ=7 : M$="Def-Jam" : End If 
    If Y>182 and Y<194 : A2=4 : SANZ=5 : M$="Hundred" : End If 
    Put Block 2,166,83+AA2*15-AA2
    Put Block 1,166,83+A2*15-A2 : AA2=A2
  End If 
  If Y>216
    Erase 1 : Erase 13 : Erase 14 : Erase 15
    Fade 3 : Wait 50
    If SCOK=True
      Open Out 1,"score.dat"
        For I2=1 To 40
          Print #1,SNAME2$(I2)
          Print #1,SCORE2$(I2)
        Next I2
      Close 1
      Wait 300
    End If 
    End 
  End If 
  Sam Play A,A,SPF : Wait 9
  If Y>197 and Y<207 Then SP=A : Exit 
Loop 
For I=1 To 9
  For I2=1 To 14
    HF(I,I2)=0
  Next I2
Next I
SC=0 : SC$="" : Fade 3 : Wait 50 : Hide 
End Proc
Procedure SCOREZEIGEN[M$]
Cls 0 : Unpack 14 To 0 : Screen Hide 
N=0 : M$=Upper$(M$)
If M$="EASY   " Then X=106 : Q=0
If M$="MEDIUM " Then X=98 : Q=1
If M$="DEF-JAM" Then X=94 : Q=2
If M$="HUNDRED" Then X=94 : Q=3
For I=Q*10+1 To Q*10+10
  Inc N : SNAME$(N)=SNAME2$(I) : SCORE$(N)=SCORE2$(I)
Next I
N=0
If SC>Val(SCORE2$(Q*10+10))
  SCORE$(10)=Str$(SC)-" "
  For I=1 To 9
    For I2=I+1 To 10
      If Val(SCORE$(I))<Val(SCORE$(I2))
        Swap SNAME$(I),SNAME$(I2) : Swap SCORE$(I),SCORE$(I2)
      End If 
    Next I2
  Next I
  For I=1 To 10
    If SC=Val(SCORE$(I)) : N=I : End If 
  Next I
End If 
Ink 1,5 : Text X,54,"TOP-TEN OF "+M$
X=82
For I=1 To 10
  M$=Str$(I)
  If M$=" 10" Then M$=M$-" "
  If I=N : Ink 0 : SNAME$(N)="A......." : Else Ink 1 : End If 
  Text X,91+I*9,M$+". "+SNAME$(I)+" "+String$("0",7-Len(SCORE$(I)))+SCORE$(I)
Next I
If N : SNAME$(N)="" : End If 
Screen Show 
Screen Open 1,320,230,8,Lowres
Get Palette 0 : Cls 0
For I=1 To 214 Step 2
  Screen Copy 0,77,I-1,270,I To 1,77,I-9
  Screen Copy 0,77,236-I,270,237-I To 1,77,228-I
  Wait Vbl 
Next I
Screen To Front 0 : Screen Close 1
X=0 : I2=65 : I3=65 : Ink 0
For I=1 To 10
  If I=N
    M$="" : X=0
    Repeat 
      If Jdown(1) or Jright(1)
        Add I2,1,65 To 92
        I3=I2
        If I3=91 : I3=45 : Else If I3=92 : I3=46 : End If : End If 
        Text 114+X,91+I*9,Chr$(I3)
        Wait 7
      End If 
      If Jup(1) or Jleft(1)
        Add I2,-1,65 To 92
        I3=I2
        If I3=91 : I3=45 : Else If I3=92 : I3=46 : End If : End If 
        Text 114+X,91+I*9,Chr$(I3)
        Wait 7
      End If 
      If Fire(1)
        Wait 15
        M$=M$+Chr$(I3)
        I3=65 : I2=65 : Add X,8 : If X<64 : Text 114+X,91+I*9,"A" : End If 
      End If 
    Until X=64
    I=10 : I3=0 : SNAME$(N)=M$
    For I2=Q*10+1 To Q*10+10
      Add I3,1 : SNAME2$(I2)=SNAME$(I3) : SCORE2$(I2)=SCORE$(I3)
    Next I2
    If Str$(N)=" 10" : M$=Str$(N)-" " : Else M$=Str$(N) : End If 
    Ink 1 : Text 82,91+N*9,M$+". "+SNAME$(N)+" "+String$("0",7-Len(SCORE$(N)))+SCORE$(N)
    SCOK=True
  End If 
Next I
Repeat : Until Fire(1)=True
Ink 0
For I=1 To 90
  Box 76+I,34+I To 260-I,191-I
  Wait Vbl 
Next I
End Proc