'* ------------------------------------------ '* Brainsphere V1.0a '* Brainsphere ©1995 by Testaware, Inc. '* Brainsphere V1.0a ®1995 by Volker Stepprath '* S: 15-01-95 12:27:34 '* E: 20-02-95 12:10:34 '* ------------------------------------------ Flush Request Off Dim XA$(5),XP$(3),XS$(9),XS(9),XF(7,7),XM(3),XK(3),XT(3),XC(3) Global XA$(),XP$(),XS$(),XS(),XF(),XM(),XK(),XT(),XC() Global XP,XA,XC,XMODE,XLEVEL,XTIME,XJUMP,XDEMO,XMUSIC _INTRO _MAIN Procedure _INTRO N$="Brainsphere.Dat" If File Type(N$)=True N=File Size(N$) Bload N$,7 N=Unsquash(Start(7),N) End If N$="Brainsphere.Ten" If File Type(N$)=True Trap Open In 1,N$ If Errtrap=False For I=0 To 9 Trap Input #1,XS$(I) Trap Input #1,XS(I) Next Close 1 End If End If Unpack 16 To 0 Screen Hide If Prg State0 Move Y 3,"(1,-2,5)" Move On Clear Key Wait 5 N=(Y Bob(3)-42)/10 Y=Y Bob(3) T=Timer Else If(J=2 or A=31) and N<12 Move Y 3,"(1,2,5)" Move On Clear Key Wait 5 N=(Y Bob(3)-42)/10 Y=Y Bob(3) T=Timer Else If J=4 or A=29 J=False Exit Else If J=8 or A=28 J=True Exit Else If J=16 or A=32 Exit End If End If If Timer-T>1000 Fade 2 : Wait 30 N=XP A=XA For I=0 To 3 N(I)=XC(I) XC(I)=3 Next L=XLEVEL M=XMUSIC XMUSIC=1 XA=%1111 XDEMO=True _SINGLE XMUSIC=M XP=N XA=A For I=0 To 3 XC(I)=N(I) Next XLEVEL=L XDEMO=False Goto A End If Loop Clear Key If N<4 : Rem * Spieler HUMAN - CPU If J=16 or A=32 _I[XP$(N)] Ink 19 : Bar 101,199 To 218,210 If Param$<>"" XP$(N)=Left$(Param$,15) Gosub _INSTALL End If Else If J Add XC(N),1,0 To 4 Else Add XC(N),-1,0 To 4 End If If XC(N)=0 N$(N)="JOYSTICK 0" Bset N,XA Else If XC(N)=1 N$(N)="JOYSTICK 1" Bset N,XA Else If XC(N)=2 N$(N)="KEYBOARD " Bset N,XA Else If XC(N)=3 N$(N)="COMPUTER " Bset N,XA Else If XC(N)=4 N$(N)="SLEEPING " Bclr N,XA End If _T[195,41+N*10,N$(N),1] Wait 3 End If Else If N=4 Add XTIME,1,0 To 1 If XTIME N$(N)="ON " Else N$(N)="OFF" End If _T[195,41+N*10,N$(N),1] Wait 5 Else If N=5 If J Add XP,1,1 To 4 Else Add XP,-1,1 To 4 End If _T[190,41+N*10,Str$(XP),1] Wait 3 Else If N=6 : Rem * SPIELBRETT If J Add XLEVEL,1,-1 To 99 Else Add XLEVEL,-1,-1 To 99 End If If XLEVEL>-1 and Deek(Start(7)+XLEVEL*68+64) N$(5)=String$("0",2-Len(Str$(XLEVEL)-" "))+Str$(XLEVEL)-" "+" " Else XLEVEL=-1 N$(5)="RANDOM" End If _T[195,41+N*10,N$(5),1] Else If N=7 If J Add XMODE,1,0 To 3 Else Add XMODE,-1,0 To 3 End If If XMODE=0 N$(6)="SINGLE " Else If XMODE=1 N$(6)="CUP " Else If XMODE=2 N$(6)="LEAGUE " Else If XMODE=3 N$(6)="CHALLANGE" End If _T[195,41+N*10,N$(6),1] Else If N=8 and Length(5) If J Add XMUSIC,1,0 To 2 Else Add XMUSIC,-1,0 To 2 End If If XMUSIC=0 N$(7)="OFF " Else If XMUSIC=1 N$(7)="MUSIC " Else If XMUSIC=2 N$(7)="SFX " End If _T[195,41+N*10,N$(7),1] Else If N=9 and(J=16 or A=32) : Rem * START If XA Fade 2 : Wait 30 N=XP A=XA L=XLEVEL T=XTIME If XMUSIC<>1 Sam Stop %1100 Sam Loop Off End If On XMODE+1 Proc _SINGLE,_CUP,_LEAGUE,_CHALLANGE XP=N XA=A XLEVEL=L XTIME=T If XMUSIC<>1 Sam Play %1100,1 Sam Loop On End If Goto A End If Else If N=10 and(J=16 or A=32) : Rem * EDITOR Fade 2 : Wait 30 _EDITOR Goto A Else If N=11 and(J=16 or A=32) : Rem * ABOUT Fade 2 : Wait 30 _ABOUT Goto A Else If N=12 and(J=16 or A=32) : Rem * EXIT Fade 2 : Wait 10 : Sam Stop %1111 : Wait 60 Screen Close 0 Screen Close 1 If XC Trap Open Out 1,"Brainsphere.Ten" If Errtrap=False For I=0 To 9 Print #1,XS$(I) Print #1,XS(I) Next Close 1 Wait 50 End If End If If Prg State-1 N$=Str$(XLEVEL)-" " _T[195,101,String$("0",2-Len(N$))+N$+" ",1] Else _T[195,101,"RANDOM",1] End If N$="BRAINSPHERE (C)1995 BY TESTAWARE, INC." _T[160-(Len(N$)*5)/2,183,N$,2] Return Data XP$(0)+String$(".",15-Len(XP$(0)))+": ",N$(0) Data XP$(1)+String$(".",15-Len(XP$(1)))+": ",N$(1) Data XP$(2)+String$(".",15-Len(XP$(2)))+": ",N$(2) Data XP$(3)+String$(".",15-Len(XP$(3)))+": ",N$(3) Data "TIMER..........: ",N$(4) Data "START PLAYER...: ",Str$(XP)-" " Data "STARTBOARD.....: ",N$(5) Data "GAMEMODE.......: ",N$(6) Data "SOUND..........: ",N$(7) Data "START GAME "," " Data "EDITOR "," " Data "ABOUT "," " Data "EXIT BRAINSPHERE ","" End Proc Procedure _SINGLE _CREATEBOARD _ISTIME Do N=False J=False XJUMP=False Repeat If XC(XP-1)=0 J=Joy(0) Else If XC(XP-1)=1 J=Joy(1) Else If XC(XP-1)=2 N=Asc(Inkey$) If Key Shift XJUMP=True Else XJUMP=False End If Else If XC(XP-1)=3 _CPU J=Param End If Exit If XA=0,2 If Asc(Inkey$)=27 N=27 Exit 2 End If Clear Key Until J+N '* Wenn Fire dann Sprung '~~~~~~~~~~~~~~~~~~~~~~~ If J>15 Then XJUMP=True : J=J mod 16 : Rem * Fire ausfiltern A=XA X=X Bob(4+XP) Y=Y Bob(4+XP) If J=1 or N=30 _JOY[0] Else If J=2 or N=31 _JOY[1] Else If J=4 or N=29 _JOY[2] Else If J=8 or N=28 _JOY[3] End If Exit If XA=0 If XA<>A Repeat Add XP,1,1 To 4 _CHECKPLAYER Exit If XA=0,2 Until Btst(XP-1,XA) Else If(X-X Bob(4+XP)+Y-Y Bob(4+XP)) Repeat Add XP,1,1 To 4 _CHECKPLAYER Exit If XA=0,2 Until Btst(XP-1,XA) End If End If '* Flash-Bob Bob 9,222,1+XP*40,79 Bob 10,X Bob(4+XP),Y Bob(4+XP),80 Loop Every Off Flash Off Bob Off If N=27 _O["GAME ABORTED !"] End If If XDEMO Then _WAIT[5] Else _WAIT[0] Fade 2 : Wait 30 If XDEMO=False _MASK Dim N$(3),N(3) For I=0 To 3 If XC(I)<4 N(I)=XK(I)*1000+XM(I)*10+XT(I) N$(I)=XP$(I)+String$(" ",19-Len(XP$(I))) N$(I)=N$(I)+String$("0",3-Len(Str$(XK(I))-" "))+Str$(XK(I))-" "+" " N$(I)=N$(I)+String$("0",3-Len(Str$(XM(I))-" "))+Str$(XM(I))-" "+" " N$(I)=N$(I)+String$("0",2-Len(Str$(XT(I))-" "))+Str$(XT(I))-" " Else N$(I)=String$("-",36) End If Next For I=0 To 2 For I2=I+1 To 3 If N(I)15 or A=32 If(J=4 or A=29) and X Bob(3)>29 Move X 3,"(1,-2,5)" Else If(J=8 or A=28) and X Bob(3)<289 Move X 3,"(1,2,5)" End If Move On Clear Key Wait 5 End If Loop X=X Bob(3) Y=Y Bob(3) Bob Off 3 Wait 5 If Y>161 If X>28 and X<90 and XW=False : Rem * CONTINUE _G[22,157,90,166,1] XA=XN A=XLEVEL Fade 2 : Wait 30 _SINGLE XLEVEL=A Exit Else If X>98 and X<150 and XW=False : Rem * SAVE _G[91,157,159,166,1] Trap Open Out 1,"Brainsphere.Cup" If Errtrap _O["DISKERROR OCCURRED !"] _WAIT[5] Ink 19 : Bar 101,199 To 218,210 Else Print #1,XQ Print #1,XS Print #1,XF Print #1,XN Print #1,XLEVEL For I=0 To 3 Print #1,XC(I) Print #1,XP$(I) Next Close 1 End If _WAIT[1] _G[91,157,159,166,0] Else If X>163 and X<220 : Rem * LOAD _G[160,157,228,166,1] Trap Open In 1,"Brainsphere.Cup" If Errtrap _O["DISKERROR OCCURED !"] _WAIT[5] Ink 19 : Bar 101,199 To 218,210 Else Input #1,XQ Input #1,XS Input #1,XF Input #1,XN Input #1,XLEVEL For I=0 To 3 Input #1,XC(I) Input #1,XP$(I) Next XW=False Close 1 Fade 2 : Wait 30 Goto A End If _WAIT[1] _G[160,157,228,166,0] Else If X>238 and X<290 : Rem * QUIT _G[229,157,297,166,1] _WAIT[1] Fade 2 : Wait 30 Pop Pop Proc End If End If Gosub _BOB Loop _INSTALL: _MASK _T[143,24,"THE CUP",2] _T[28,54,"NAME P QUATER SEMI FINAL WINNER!",1] For I=0 To 3 _T[28,69+I*15,XP$(I),2] If XC(I)<2 N$="J" Else If XC(I)=2 N$="K" Else If XC(I)=3 N$="C" End If _T[138,69+I*15,N$,2] _T[164,69+I*15,"*",2] Next _T[36,159,"CONTINUE",2] _T[116,159,"SAVE",2] _T[185,159,"LOAD",2] _T[256,159,"QUIT",2] For I=0 To 4 A=52+I*15 _G[22,A,132,A+9,0] _G[133,A,146,A+9,0] _G[147,A,186,A+9,0] _G[187,A,216,A+9,0] _G[217,A,251,A+9,0] _G[252,A,297,A+9,0] Next _G[22,157,90,166,0] _G[91,157,159,166,0] _G[160,157,228,166,0] _G[229,157,297,166,0] For I=0 To 3 Ink I+2 : Paint 136,70+I*15,0 Next _BOB: Bob 3,X,Y,62 Amal 3,"A0,(62,4)(63,2)(64,2)(65,2)(66,2)(67,2)(68,4)(67,2)(66,2)(65,2)(64,2)(63,2)" Amal On 3 Return _WINNER: For I=0 To 3 If Btst(I,XN) N=XK(I)*100+XM(I)*10+XT(I) N$(I)=String$("0",4-Len(Str$(N)-" "))+Str$(N)-" "+XP$(I) Else N$(I)="" End If Next Sort N$(0) Return _TABELLE: For I=0 To 3 If Btst(I,XQ) Then _T[164,69+I*15,"*",2] If Btst(I,XS) Then _T[199,69+I*15,"*",2] If Btst(I,XF) Then _T[232,69+I*15,"*",2] If Btst(I,XW) Then _T[273,69+I*15,"*",2] Next Return End Proc Procedure _LEAGUE Dim N$(3),P$(3),B(3),P(3) For I=0 To 3 N$(I)=XP$(I)+Space$(27-Len(XP$(I))) If XC(I)<2 N$="J" Else If XC(I)=2 N$="K" Else If XC(I)=3 N$="C" End If N$(I)=N$(I)+N$ P$(I)=XP$(3-I) Next '* Koordinaten für Bob '~~~~~~~~~~~~~~~~~~~~~ X=29 Y=162 Gosub _INSTALL Screen Show Fade 2 To 0 : Wait 30 Do Do J=Joy(1) : A=Asc(Inkey$) If J+A Exit If J>15 or A=32 If(J=4 or A=29) and X Bob(3)>29 Move X 3,"(1,-2,5)" Else If(J=8 or A=28) and X Bob(3)<289 Move X 3,"(1,2,5)" End If Move On Clear Key Wait 5 End If Loop X=X Bob(3) Y=Y Bob(3) Bob Off 3 Wait 5 If Y>161 If X>28 and X<90 and G<8 : Rem * CONTINUE _G[22,157,90,166,1] XA=%1111 A=XLEVEL Fade 2 : Wait 30 _SINGLE XLEVEL=A Inc G Gosub _WINNER Gosub _INSTALL Screen Show Fade 2 To 0 : Wait 30 Else If X>98 and X<150 and G<8 : Rem * SAVE _G[91,157,159,166,1] Trap Open Out 1,"Brainsphere.Leg" If Errtrap _O["DISKERROR OCCURRED !"] _WAIT[5] Ink 19 : Bar 101,199 To 218,210 Else Print #1,XLEVEL Print #1,G For I=0 To 3 Print #1,XC(I) Print #1,XP$(I) Print #1,P$(I) Print #1,B(I) Print #1,P(I) Next Close 1 End If _WAIT[1] _G[91,157,159,166,0] Else If X>163 and X<220 : Rem * LOAD _G[160,157,228,166,1] Trap Open In 1,"Brainsphere.Leg" If Errtrap _O["DISKERROR OCCURRED !"] _WAIT[5] Ink 19 : Bar 101,199 To 218,210 Else Input #1,XLEVEL Input #1,G For I=0 To 3 Input #1,XC(I) Input #1,XP$(I) Input #1,P$(I) Input #1,B(I) Input #1,P(I) Next Close 1 For I=0 To 3 N$(I)=XP$(I)+Space$(27-Len(XP$(I))) If XC(I)<2 N$="J" Else If XC(I)=2 N$="K" Else If XC(I)=3 N$="C" End If N$(I)=N$(I)+N$ Next Fade 2 : Wait 30 Gosub _INSTALL Screen Show Fade 2 To 0 : Wait 30 End If _WAIT[1] _G[160,157,228,166,0] Else If X>238 and X<290 : Rem * QUIT _G[229,157,297,166,1] _WAIT[1] Fade 2 : Wait 30 Pop Proc End If End If Gosub _BOB Loop _INSTALL: _MASK _T[135,24,"THE LEAGUE",2] _T[28,54,"R NAME P GAMES BALLS POINTS",1] For I=0 To 3 _T[23,69+I*15,Str$(1+I),2] _T[203,69+I*15,Str$(G)-" ",2] Next For I=3 To 0 Step -1 For I2=0 To 3 If Instr(P$(I),XP$(I2)) A=114-I*15 _T[43,A,N$(I2),2] _T[233,A,String$("0",3-Len(Str$(B(I2))-" "))+Str$(B(I2))-" ",2] _T[273,A,String$("0",2-Len(Str$(P(I2))-" "))+Str$(P(I2))-" ",2] End If Next Next For I=0 To 4 A=52+I*15 _G[22,A,37,A+9,0] _G[38,A,172,A+9,0] _G[173,A,186,A+9,0] _G[187,A,222,A+9,0] _G[223,A,256,A+9,0] _G[257,A,297,A+9,0] Next _T[36,159,"CONTINUE",2] _T[116,159,"SAVE",2] _T[185,159,"LOAD",2] _T[256,159,"QUIT",2] _G[22,157,90,166,0] _G[91,157,159,166,0] _G[160,157,228,166,0] _G[229,157,297,166,0] For I=3 To 0 Step -1 For I2=0 To 3 If Instr(P$(I),XP$(I2)) Ink I2+2 : Paint 175,114-I*15,0 End If Next Next _BOB: Bob 3,X,Y,62 Amal 3,"A0,(62,4)(63,2)(64,2)(65,2)(66,2)(67,2)(68,4)(67,2)(66,2)(65,2)(64,2)(63,2)" Amal On 3 Return _WINNER: For I=0 To 3 N=XK(I)*100+XM(I)*10+XT(I) P$(I)=String$("0",4-Len(Str$(N)-" "))+Str$(N)-" "+XP$(I) Next Sort P$(0) For I=3 To 0 Step -1 For I2=0 To 3 If Instr(P$(I),XP$(I2)) If I=1 Inc P(I2) Else If I=2 Add P(I2),2 Else If I=3 Add P(I2),4 End If End If Next Next For I=0 To 3 Add B(I),XK(I) N=P(I)*1000+B(I) P$(I)=String$("0",6-Len(Str$(N)-" "))+Str$(N)-" "+XP$(I) Next Sort P$(0) Return End Proc Procedure _CHALLANGE For I=0 To 3 If XC(I)<3 Then P=I : A=XC(I) : B=True XC(I)=3 Next If B=False Then A=1 XC(P)=A XLEVEL=-1 XTIME=True XK(P)=0 XM(P)=0 XT(P)=0 Do _MASK If XK(P)>0 Then Add S,XK(P)*100+XM(P)*10+XT(P) If N=False XA=%1111 Add XLEVEL,1,0 To 99 If Deek(Start(7)+XLEVEL*68+64)=0 XLEVEL=0 End If Restore End If _T[127,50,"THE CHALLENGE",2] Read N$ : _T[160-(Len(N$)*5)/2,100,N$,2] Read N$ : _T[160-(Len(N$)*5)/2,160,N$,2] Screen Show Fade 2 To 0 : Wait 30 _WAIT[0] Fade 2 : Wait 30 If N=False _SINGLE For I=0 To 3 If XK(P)XS(9) XC=True XS(9)=S XS$(9)=XP$(P) For I=0 To 8 For I2=I+1 To 9 If XS(I2)>XS(I) Swap XS(I),XS(I2) Swap XS$(I),XS$(I2) End If Next Next End If _T[113,45,"THE CHALLENGE TOP TEN",2] For I=0 To 9 _T[95,70+I*8,String$(" ",2-Len(Str$(1+I)-" "))+Str$(1+I)-" "+". "+XS$(I)+String$(".",15-Len(XS$(I)))+" "+String$("0",7-Len(Str$(XS(I))-" "))+Str$(XS(I))-" ",2] Next _T[65,183,"BRAINSPHERE (C)1995 BY TESTAWARE, INC.",2] Fade 2 To 0 : Wait 30 _WAIT[0] Fade 2 : Wait 30 Data "PLAYER: "+XP$(P)+" SCORE: "+String$("0",7-Len(Str$(S)-" "))+Str$(S)-" " Data "PREPARE FOR BOARD "+String$("0",2-Len(Str$(XLEVEL)-" "))+Str$(XLEVEL)-" " Data "GAME OVER" Data "FINAL SCORE: "+String$("0",7-Len(Str$(S)-" "))+Str$(S)-" " End Proc Procedure _ABOUT _MASK Do Read N$ Exit If N$="|" X=160-(Len(N$)*5)/2 _T[X,25+Y*9,N$,2] Inc Y Loop Screen Show Fade 2 To 0 : Wait 30 _WAIT[60] Fade 2 : Wait 30 Data "","" Data "THIS GAME IS ONE MORE > PD < RELEASE !" Data "","" Data "FOR BUG REPORTS CONTACT:" Data "" Data "VOLKER STEPPRATH " Data "TEGELER STRASSE 7" Data "40789 MONHEIM " Data "GERMANY " Data "" Data "READ DOC FILE FOR MORE INFORMATIONS" Data "","","","" Data "BRAINSPHERE (C)1995 BY TESTAWARE, INC." Data "|" End Proc Procedure _EDITOR '* XT=Time '* XM=Moves '* XL=Level XM=1 Dim N$(24) For I=0 To 24 Read N$(I) Next For Y=0 To 7 For X=0 To 7 XF(X,Y)=0 Next Next Unpack 17 To 1 Screen Hide Screen Display 1,,61,, For I=0 To 31 Colour I,0 Next Ink 19 : Bar 208,19 To 293,184 _T[237,20,"EDITOR",2] For Y=0 To 4 For X=0 To 4 Inc N : Exit If N>25 If N<22 Paste Icon 206+X*18,41+Y*18,N Else Paste Bob 206+X*18,41+Y*18,(N-22)*4+42 End If _G[205+X*18,40+Y*18,222+X*18,57+Y*18,0] Next Next _G[205,40,222,57,1] _T[208,142,"MOVES",1] _T[241,142,"TIME",1] _T[271,142,"FILL",1] _T[208,152,"BOARD",1] _T[238,152,"PUTON",1] _T[268,152,"GETIN",1] _T[241,162,"EXIT",1] _O["USE MOUSE !"] For I=0 To 2 _G[205+I*30,140,234+I*30,149,0] _G[205+I*30,150,234+I*30,159,0] Next _G[205,160,294,169,0] Screen Show Change Mouse 2 Show X Mouse=342 Y Mouse=109 Fade 2 To 0 : Wait 30 '* Hauptschleife '~~~~~~~~~~~~~~~ Do N=Wait Loop Exit If N=27 If N204 and X<295 and Y>39 and Y<130 For A=0 To 4 For B=0 To 4 _G[205+A*18,40+B*18,222+A*18,57+B*18,0] Next Next A=(X-205)/18 B=(Y-40)/18 _G[205+A*18,40+B*18,222+A*18,57+B*18,1] XN=A+B*5 _O[N$(XN)] End If '* Optionen aufrufen '~~~~~~~~~~~~~~~~~~~ If X>204 and X<295 '* MOVES - TIME - FILL '~~~~~~~~~~~~~~~~~~~~~ If Y>139 and Y<150 A=(X-205)/30 _G[205+A*30,140,234+A*30,149,1] Ink 15 : Bar 105,202 To 215,207 If A=0 N$=Str$(XM)-" " : _T[152,202,String$("0",3-Len(N$))+N$,0] Wait 3 While Mouse Key If N=-1 Add XM,1,1 To 999 Else Add XM,-1,1 To 999 End If N$=Str$(XM)-" " : _T[152,202,String$("0",3-Len(N$))+N$,0] : Wait 2 Wend Else If A=1 N$=Str$(XT)-" " : _T[152,202,String$("0",3-Len(N$))+N$,0] Wait 3 While Mouse Key If N=-1 Add XT,1,1 To 999 Else Add XT,-1,1 To 999 End If N$=Str$(XT)-" " : _T[152,202,String$("0",3-Len(N$))+N$,0] : Wait 2 Wend Else If A=2 If XN<21 _O["FILLING BOARD !"] If XN=5 : XN=-5 : End If For X=0 To 7 For Y=0 To 7 XF(X,Y)=XN+5 Next Next Gosub _SHOWBOARD End If End If _G[205+A*30,140,234+A*30,149,0] '* LEVEL - PUTON - GETIN '~~~~~~~~~~~~~~~~~~~~~~~ Else If Y>149 and Y<158 A=(X-205)/30 _G[205+A*30,150,234+A*30,159,1] Ink 15 : Bar 105,202 To 215,207 If A=0 N$=Str$(XL)-" " _T[152,202,String$("0",2-Len(N$))+N$,0] Wait 3 While Mouse Key If N=-1 Add XL,1,0 To 99 Else Add XL,-1,0 To 99 End If N$=Str$(XL)-" " _T[152,202,String$("0",2-Len(N$))+N$,0] Wait 2 Wend Else If A=1 S=Start(7)+XL*68 For X=0 To 7 For Y=0 To 7 XF(X,Y)=Peek(S+Y+X*8) Next Next XM=Deek(S+64) XT=Deek(S+66) Gosub _SHOWBOARD _O["LEVEL"+Str$(XL)+" INSTALLED !"] Else If A=2 B=0 For X=0 To 7 For Y=0 To 7 N=XF(X,Y) If N>0 and N<5 Bset N-1,B End If Next Next If B<>%1111 _O["IT MUST BE 4 PLAYERS !"] Else S=Start(7)+XL*68 For X=0 To 7 For Y=0 To 7 Poke S+Y+X*8,XF(X,Y) Next Next Doke S+64,XM Doke S+66,XT _O["LEFT-DISK / RIGTH-MEM"] If Wait Loop=-1 _O["COMPRESSING DATAS..."] N=Squash(Start(7),Length(7),-1,2048,14) Trap Bsave "Brainsphere.Dat",Start(7) To Start(7)+N N=Unsquash(Start(7),N) If Errtrap _O["DISKERROR OCCURRED !"] Else _O["LEVELS ON DISK / MEM !"] End If Else _O["LEVELS IN MEMORY !"] End If End If End If _G[205+A*30,150,234+A*30,159,0] End If End If '* EXIT '~~~~~~ If X>204 and X<295 and Y>159 and Y<170 _G[205,160,294,169,1] Exit End If '* Malfeld setzen '~~~~~~~~~~~~~~~~ If X>17 and X<194 and Y>17 and Y<194 A=(X-18)/24 B=(Y-18)/24 Ink 19 : Bar 16+A*24,17+B*24 To 26+A*24,26+B*24 If XN<21 : Rem * Icon`s Paste Icon 14+A*24,14+B*24,1+XN XF(A,B)=5+XN Else If XN>20 and XN<25 : Rem * Bob`s N=XN-20 For I=0 To 7 For I2=0 To 7 If XF(I,I2)=N Bar 16+I*24,17+I2*24 To 26+I*24,26+I2*24 Paste Icon 14+I*24,14+I2*24,6 XF(I,I2)=0 Exit 2 End If Next Next Paste Bob 13+A*24,14+B*24,(XN-21)*4+41 XF(A,B)=N End If Ink 18 : Draw 16,18 To 16,194 End If End If Loop Fade 2 : Wait 30 Hide Pop Proc '* Board installieren '~~~~~~~~~~~~~~~~~~~~ _SHOWBOARD: Ink 19 For X=0 To 7 For Y=0 To 7 N=XF(X,Y) Bar 16+X*24,17+Y*24 To 26+X*24,26+Y*24 If N=0 or N>4 If N=0 : N=10 : End If Paste Icon 14+X*24,14+Y*24,N-4 Else Paste Bob 13+X*24,14+Y*24,N*4+37 End If Next Next Ink 18 : Draw 16,18 To 16,194 Return Data "BALL 1","BALL 2","BALL 3","BALL 4","NON CHANGEABLE STONE" Data "NORMAL FIELD","GET 1 EXTRA MOVE","GET 2 EXTRA MOVES","GET 3 EXTRA MOVES","GET 4 EXTRA MOVES" Data "GET 10 BONUS SECONDS","GET 15 BONUS SECONDS","GET 20 BONUS SECONDS","TELEPORTING","GET ALL BALLS" Data "ALL BALLS TO STONE","LOOSING ALL BALLS","PLAYER OVER","LOOSING RANDOM SECONDS","LOOSING RANDOM MOVES" Data "RANDOM CHOOSE","PLAYER 1","PLAYER 2","PLAYER 3","PLAYER 4" End Proc Procedure _JOY[J] X=X Bob(4+XP)/24 Y=Y Bob(4+XP)/24 Randomize Timer N=True If J=0 If Y>0 : N=XF(X,Y-1) : End If Else If J=1 If Y<7 : N=XF(X,Y+1) : End If Else If J=2 If X>0 : N=XF(X-1,Y) : End If Else If J=3 If X<7 : N=XF(X+1,Y) : End If End If '* Spieler = Randfeld '~~~~~~~~~~~~~~~~~~~~ If N=True Then Pop Proc '* Feld = Spieler '~~~~~~~~~~~~~~~~ If N>0 and N<5 Then Pop Proc '* Wenn Kugel dann Sprung '~~~~~~~~~~~~~~~~~~~~~~~~ If N>4 and N<10 Then XJUMP=True '* Amalstring bestimmen '~~~~~~~~~~~~~~~~~~~~~~ If XJUMP : Rem * Sprung ? N=True If J=0 and Y>1 N=XF(X,Y-2) : X=0 : Y=-48 Else If J=1 and Y<6 N=XF(X,Y+2) : X=0 : Y=48 Else If J=2 and X>1 N=XF(X-2,Y) : X=-48 : Y=0 Else If J=3 and X<6 N=XF(X+2,Y) : X=48 : Y=0 End If If N=0 or N>9 C=33+J*2 N$="A1,("+Str$(C)+",2)("+Str$(C+1)+",13)("+Str$(C)+",1);M"+Str$(X)+","+Str$(Y)+",16" Else _ISTIME Pop Proc End If Else N$=XA$(J) End If '* Zeit w. Überschneidung abschalten '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Every Off Bob Off 10 : Wait Vbl '* Spielerfarbe '~~~~~~~~~~~~~~ Colour 14,Colour(1+XP) Colour 12,Colour(21+XP*2) Colour 31,Colour(22+XP*2) '* Spielerposition '~~~~~~~~~~~~~~~~~ X=X Bob(4+XP) Y=Y Bob(4+XP) '* Spieler in Animbob '~~~~~~~~~~~~~~~~~~~~ Bob Off 4+XP Bob 1,X,Y,41+(XP-1)*4+J Amal 1,N$ Amal On 1 If XMUSIC=2 and XJUMP Then Sam Play %11,3 Wait Vbl While Chanmv(1) : Wend '* Altes Feld in Spielerkugel, wenn nicht gesprungen '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If XJUMP=False XF(X/24,Y/24)=XP+4 Bob 2,X+1,Y+1,57 Amal 2,XA$(4) Amal On 2 If XMUSIC=2 Sam Play %11,7 End If Wait Vbl While Chanan(2) : Wend Paste Icon X-7,Y-7,XP : Wait Vbl Bob Off 2 : Wait Vbl Inc XK(XP-1) Else XF(X/24,Y/24)=0 End If '* Austausch Animbob in Spieler '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ X=X Bob(1) Y=Y Bob(1) Bob 4+XP,X,Y,41+(XP-1)*4+J : Wait Vbl Bob Off 1 : Wait Vbl Paste Icon X-7,Y-7,6 : Wait Vbl If N>10 and XMUSIC=2 Then Sam Play %11,2 '* Neues Feld in Spieler '~~~~~~~~~~~~~~~~~~~~~~~ X=X/24 Y=Y/24 XF(X,Y)=XP '* Wenn gesprungen, anliegende Felder aneignen '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If XJUMP If X>0 D=XF(X-1,Y) : If D>4 and D<9 : _CHANGEBALL[X-1,Y] : End If End If If X<7 D=XF(X+1,Y) : If D>4 and D<9 : _CHANGEBALL[X+1,Y] : End If End If If Y>0 D=XF(X,Y-1) : If D>4 and D<9 : _CHANGEBALL[X,Y-1] : End If End If If Y<7 D=XF(X,Y+1) : If D>4 and D<9 : _CHANGEBALL[X,Y+1] : End If End If End If '* Effekt von Feld auslösen '~~~~~~~~~~~~~~~~~~~~~~~~~~ If N>10 On N-10 Proc _E01,_E02,_E03,_E04,_E05,_E06,_E07,_E08,_E09,_E10,_E11,_E12,_E13,_E14,_E15 End If '* Zugbonusende ? '~~~~~~~~~~~~~~~~ XM(XP-1)=Max(0,XM(XP-1)-1) If XM(XP-1)=0 _O["NO MOVES LEFT !"] _PLAYEROFF _SHOWSTAND End If '* Ausgabe Züge, Kugeln & Zeit '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ _SHOWSTAND '* Zeit gg. wieder anschalten '~~~~~~~~~~~~~~~~~~~~~~~~~~~~ _ISTIME End Proc Procedure _CPU X=X Bob(4+XP)/24 Y=Y Bob(4+XP)/24 K=XP+4 Gosub U : If U<0 Then N=1 : Goto B Gosub D : If D<0 Then N=2 : Goto B If U<>D If U>D : H=1 : UD=U Else H=2 : UD=D : End If Else A=Rnd(1) If A=0 : H=1 : UD=U Else H=2 : UD=D : End If End If Gosub L : If L<0 Then N=4 : Goto B Gosub R : If R<0 Then N=8 : Goto B If L<>R If L>R : W=4 : LR=L Else W=8 : LR=R : End If Else A=Rnd(1) If A=0 : W=4 : LR=L Else W=8 : LR=D : End If End If If UD<>LR If UD>LR : N=H : A=UD Else N=W : A=LR : End If Else A=Rnd(1) If A=0 : N=H : A=UD Else N=W : A=LR : End If End If If A>1 If A<4 If Rnd(1) : Bset 4,N : End If Else Bset 4,N End If End If Goto B U: If Y>1 If XF(X,Y-1)=0 or XF(X,Y-1)>4 A=Y-2 B=XF(X,A) If B=19 : Rem * Kugeln aneignen ? U=5 End If If(B=0 or B>9) and(B<20 or B>22) C=XF(X,A+1) If C>4 and C<9 and C<>K Inc U End If If A>0 C=XF(X,A-1) If C>4 and C<9 and C<>K Inc U End If End If If X>0 C=XF(X-1,A) If C>4 and C<9 and C<>K Inc U End If End If If X<7 C=XF(X+1,A) If C>4 and C<9 and C<>K Inc U End If End If End If End If End If If Y>0 and U<5 C=XF(X,Y-1) If C=19 : Rem * Alle Kugeln U=-2 End If If C>19 and C<25 U=-1 End If If C=0 or C>9 Inc U End If End If Return D: If Y<6 If XF(X,Y+1)=0 or XF(X,Y+1)>4 A=Y+2 B=XF(X,A) If B=19 : Rem * Kugeln aneignen ? D=5 End If If(B=0 or B>9) and(B<20 or B>22) C=XF(X,A-1) If C>4 and C<9 and C<>K Inc D End If If A<7 C=XF(X,A+1) If C>4 and C<9 and C<>K Inc D End If End If If X>0 C=XF(X-1,A) If C>4 and C<9 and C<>K Inc D End If End If If X<7 C=XF(X+1,A) If C>4 and C<9 and C<>K Inc D End If End If End If End If End If If Y<7 and D<5 C=XF(X,Y+1) If C=19 : Rem * Alle Kugeln D=-2 End If If C>19 and C<25 D=-1 End If If C=0 or C>9 Inc D End If End If Return L: If X>1 If XF(X-1,Y)=0 or XF(X-1,Y)>4 A=X-2 B=XF(A,Y) If B=19 : Rem * Kugeln aneignen ? L=5 End If If(B=0 or B>9) and(B<20 or B>22) C=XF(A+1,Y) If C>4 and C<9 and C<>K Inc L End If If A>0 C=XF(A-1,Y) If C>4 and C<9 and C<>K Inc L End If End If If Y>0 C=XF(A,Y-1) If C>4 and C<9 and C<>K Inc L End If End If If Y<7 C=XF(A,Y+1) If C>4 and C<9 and C<>K Inc L End If End If End If End If End If If X>0 and L<5 C=XF(X-1,Y) If C=19 : Rem * Alle Kugeln L=-2 End If If C>19 and C<25 L=-1 End If If C=0 or C>9 Inc L End If End If Return R: If X<6 If XF(X+1,Y)=0 or XF(X+1,Y)>4 A=X+2 B=XF(A,Y) If B=19 : Rem * Kugeln aneignen ? R=5 End If If(B=0 or B>9) and(B<20 or B>22) C=XF(A-1,Y) If C>4 and C<9 and C<>K Inc R End If If A<7 C=XF(A+1,Y) If C>4 and C<9 and C<>K Inc R End If End If If Y>0 C=XF(A,Y-1) If C>4 and C<9 and C<>K Inc R End If End If If Y<7 C=XF(A,Y+1) If C>4 and C<9 and C<>K Inc R End If End If End If End If End If If X<7 and R<5 C=XF(X+1,Y) If C=19 : Rem * Alle Kugeln R=-2 End If If C>19 and C<25 R=-1 End If If C=0 or C>9 Inc R End If End If Return B: End Proc[N] Procedure _CHANGEBALL[X,Y] If XP=XF(X,Y)-4 Then Pop Proc '* Fremde Kugelanz. dezimieren, Eigene inkremiern N=XF(X,Y)-5 Dec XK(N) Inc XK(XP-1) XF(X,Y)=XP+4 X=21+X*24 Y=21+Y*24 Paste Icon X-7,Y-7,6 : Wait Vbl Bob 3,X,Y,62 Amal 3,XA$(5) Amal On 3 Wait Vbl If XMUSIC=2 Then Sam Play %11,4 While Chanan(3) : Wend Bob Off 3 Bob 2,X+1,Y+1,57 Amal 2,XA$(4) Amal On 2 Wait Vbl While Chanan(2) : Wend Paste Icon X-7,Y-7,XP : Wait Vbl Bob Off 2 : Wait Vbl End Proc Procedure _CHECKPLAYER If Not Btst(XP-1,XA) Then Pop Proc X=X Bob(4+XP)/24 Y=Y Bob(4+XP)/24 If Y>0 N=XF(X,Y-1) If N=0 or N>9 : Pop Proc : End If End If If Y>1 N=XF(X,Y-2) If(N=0 or N>9) and XF(X,Y-1)>4 : Pop Proc : End If End If If Y<7 N=XF(X,Y+1) If N=0 or N>9 : Pop Proc : End If End If If Y<6 N=XF(X,Y+2) If(N=0 or N>9) and XF(X,Y+1)>4 : Pop Proc : End If End If If X>0 N=XF(X-1,Y) If N=0 or N>9 : Pop Proc : End If End If If X>1 N=XF(X-2,Y) If(N=0 or N>9) and XF(X-1,Y)>4 : Pop Proc : End If End If If X<7 N=XF(X+1,Y) If N=0 or N>9 : Pop Proc : End If End If If X<6 N=XF(X+2,Y) If(N=0 or N>9) and XF(X+1,Y)>4 : Pop Proc : End If End If _O["OOOPS... NO WAY !"] _PLAYEROFF End Proc Procedure _CREATEBOBS '* Bob 1 - Animbob '* Bob 2 - Kugel '* Bob 3 - Stern '* Bob 4 - Explosion '* Bob 5-8 Spieler '* Bob 9 - Flash '* Bob 10 - Zeiger If Length(1)=80 Then Pop Proc '* Spieler-Bob`s von 1 - 56 '~~~~~~~~~~~~~~~~~~~~~~~~~~ For Y=0 To 4 For X=0 To 7 If I Then Paint 9+X*17,10+Y*17 Inc N : Get Bob 0,N,1+X*17,1+Y*17 To 17+X*17,17+Y*17 : Hot Spot N,$11 Next Next For I=0 To 3 Ink 2+I For Y=0 To 3 Paint 9,10+Y*17 Inc N : Get Bob 0,N,1,1+Y*17 To 17,17+Y*17 : Hot Spot N,$11 Next Next '* Ball-Bob`s 57 - 61 '~~~~~~~~~~~~~~~~~~~~~ For X=0 To 4 Inc N : Get Bob 0,N,137+X*17,1 To 153+X*17,17 : Hot Spot N,$11 Next '* Stern-Bob`s 62 - 68 '~~~~~~~~~~~~~~~~~~~~~ For X=0 To 6 Inc N : Get Bob 0,N,137+X*17,18 To 153+X*17,34 : Hot Spot N,$11 Next '* Explosion-Bob`s 69 - 78 '~~~~~~~~~~~~~~~~~~~~~~~~~ For X=0 To 9 Inc N : Get Bob 0,N,137+X*17,35 To 153+X*17,51 : Hot Spot N,$11 Next '* Flash-Bob 79 '~~~~~~~~~~~~~~ Inc N : Get Bob 0,N,137,52 To 153,68 : Hot Spot N,$11 '* Kreis-Bob 80 '~~~~~~~~~~~~~~ Inc N : Get Bob 0,N,154,52 To 170,68 : Hot Spot N,$11 End Proc Procedure _CREATEAMAL '* Spieler 1 * Bälle 2 * Stern 3 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For I=1 To 4 Channel I To Bob I Next '* Animation für Spieler C1 '~~~~~~~~~~~~~~~~~~~~~~~~~~ XA$(0)="A1,(1,2)(2,2)(3,2)(4,2)(5,2)(6,2)(7,2)(8,2)(1,2);M0,-24,16" XA$(1)="A1,(9,2)(10,2)(11,2)(12,2)(13,2)(14,2)(15,2)(16,2)(9,2);M0,24,16" XA$(2)="A1,(17,2)(18,2)(19,2)(20,2)(21,2)(22,2)(23,2)(24,2)(17,2);M-24,0,16" XA$(3)="A1,(25,2)(26,2)(27,2)(28,2)(29,2)(30,2)(31,2)(32,2)(25,2);M24,0,16" '* Animation für Bälle C2 '~~~~~~~~~~~~~~~~~~~~~~~~ XA$(4)="A1,(57,1)(58,1)(59,1)(60,1)(61,1)" '* Animation für Stern C3 '~~~~~~~~~~~~~~~~~~~~~~~~ XA$(5)="A1,(62,2)(63,1)(64,1)(65,1)(66,1)(67,1)(68,3)(67,1)(66,1)(65,1)(64,1)(63,1)" End Proc Procedure _CREATEBOARD Unpack 17 To 1 Screen Hide Screen Display 1,,60,, For I=0 To 31 Colour I,0 Next '* Zufallswahl ? '~~~~~~~~~~~~~~~ If XLEVEL=-1 Repeat XLEVEL=Rnd(99) Until Deek(Start(7)+XLEVEL*68+64) End If For I=0 To 3 XK(I)=0 XM(I)=Deek(Start(7)+XLEVEL*68+64) XT(I)=Deek(Start(7)+XLEVEL*68+66) If XT(I)=0 Then XT(I)=-1 Next '* Felder setzten '~~~~~~~~~~~~~~~~ For X=0 To 7 For Y=0 To 7 N=Peek(Start(7)+XLEVEL*68+X*8+Y) If N>4 and N<26 Then Paste Icon 14+X*24,14+Y*24,N-4 : Rem * Icon`s 5-25 If N>4 and N<9 Then Inc XK(N-5) XF(X,Y)=N Next Next _SHOWSTAND Double Buffer '* Spieler setzen '~~~~~~~~~~~~~~~~ For Y=0 To 7 For X=0 To 7 A=21+X*24 B=21+Y*24 N=XF(X,Y) If N=1 and Btst(0,XA) : Rem * (1) = Spieler 1, blau Bob 5,A,B,44 Else If N=2 and Btst(1,XA) : Rem * (2) = Spieler 2, rot Bob 6,A,B,46 Else If N=3 and Btst(2,XA) : Rem * (3) = Spieler 3, gelb Bob 7,A,B,51 Else If N=4 and Btst(3,XA) : Rem * (4) = Spieler 4, lila Bob 8,A,B,53 End If If N and N<5 If Not Btst(N-1,XA) XF(X,Y)=0 Cls 15,212,32+(N-1)*40 To 290,50+(N-1)*40 _T[230,38+(N-1)*40,"SLEEPING",0] End If End If Next Next If XDEMO Then _T[150,202,"DEMO",0] Screen Show 1 Fade 2 To 0 : Wait 30 If Not Btst(XP-1,XA) For I=0 To 3 Exit If Btst(I,XA) Next XP=I+1 End If Repeat A=XA _CHECKPLAYER If A<>XA Then Add XP,1,1 To 4 Until A=XA If XA=0 Then Pop Proc '* Flash-Bob Flash 7,"(222,3)(444,3)(666,3)(888,3)(AAA,4)(888,3)(666,3)(444,3)" Bob 9,222,1+XP*40,79 Bob 10,X Bob(4+XP),Y Bob(4+XP),80 End Proc Procedure _CREATEICONS If Length(2)=21 Then Pop Proc '* Bälle 1-5 For I=0 To 4 Inc N : Get Icon 0,N,222+I*17,1 To 237+I*17,17 Next '* Felder 5-21 For I=0 To 15 Inc N : Get Icon 0,N,1+I*17,86 To 17+I*17,102 Next Make Icon Mask End Proc Procedure _ISTIME If XTIME=False Then Pop Proc For I=0 To 3 If XT(I)>0 Then Every 25 Proc _TIME : Every On : Exit Next End Proc Procedure _PLAYEROFF If Not Btst(XP-1,XA) Then Pop Proc If XMUSIC=2 Then Sam Play %11,5 : Wait 20 X=X Bob(4+XP) Y=Y Bob(4+XP) XF(X/24,Y/24)=0 Bob Off 10 Bob Off 4+XP : Wait Vbl Bob 4,X,Y,69 : Wait Vbl Amal 4,"A1,(69,2)(70,2)(71,2)(72,2)(73,2)(74,2)(75,2)(76,2)(77,2)(78,2)" Amal On 4 If XMUSIC=2 Then Sam Play %11,6,11000 Wait Vbl While Chanan(4) : Wend Bob Off 4 : Wait Vbl Bclr XP-1,XA If XMUSIC=2 Then Wait 20 End Proc Procedure _MASK Unpack 17 To 1 Screen Hide Screen Display 1,,60,, Ink 19 : Bar 18,17 To 302,194 Bar 101,199 To 218,210 Ink 18 : Draw 18,16 To 302,16 Ink 22 : Draw 18,195 To 302,195 Ink 15 : Draw 18,196 To 302,196 For I=0 To 31 Colour I,0 Next End Proc Procedure _SHOWSTAND '* Moves, Bälle & Zeit angeben '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For I=0 To 3 If XM(I) N$=Str$(XM(I))-" " : _T[216,51+I*40,String$("0",3-Len(N$))+N$,0] Else _T[216,51+I*40,"OUT",0] End If N$=Str$(XK(I))-" " : _T[246,51+I*40,String$("0",2-Len(N$))+N$,0] If XTIME If XT(I)>0 N$=Str$(XT(I))-" " : _T[270,51+I*40,String$("0",3-Len(N$))+N$,0] Else If XT(I)=0 _T[270,51+I*40,"OUT",0] End If Else _T[270,51+I*40,"OFF",0] End If Next End Proc Procedure _T[X,Y,N$,F] T$="ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!?./`:-+*= %(),#><" L=Len(N$)-1 For I=0 To L A$=Mid$(N$,1+I,1) N=Instr(T$,A$) If N Screen Copy 0,(N-1)*5,103+F*6,N*5,109+F*6 To Physic,X+I*5,Y Screen Copy 0,(N-1)*5,103+F*6,N*5,109+F*6 To Logic,X+I*5,Y End If Next End Proc Procedure _W[X,Y,N$] T$="ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.:!?,()% " L=Len(N$)-1 For I=0 To L N=Instr(T$,Mid$(N$,1+I,1)) If N Screen 0 If N>26 Add N,-26 A=130 Else A=121 End If Get Block 1,(N-1)*9,A,9,8,1 Screen 1 Put Block 1,X+I*9,Y End If Next End Proc Procedure _O[N$] If XDEMO Then Pop Proc Screen Copy 0,171,52,287,61 To Physic,102,200 Screen Copy 0,171,52,287,61 To Logic,102,200 N$=Left$(N$,22) N=(Len(N$)*5)/2 _T[160-N,202,N$,0] End Proc Procedure _TIME If Btst(XP-1,XA) N=XP-1 If XT(N)<1 Pop Proc End If Dec XT(N) N$=Str$(XT(N))-" " : _T[270,51+N*40,String$("0",3-Len(N$))+N$,0] If XT(N)=False _O["OOOPS... TIME OUT !"] _PLAYEROFF _SHOWSTAND If XA Repeat Add XP,1,1 To 4 Until Btst(XP-1,XA) '* Flash-Bob Bob 39,222,1+XP*40,79 End If End If End If Every On End Proc Procedure _G[X,Y,XX,YY,S] If S Then A=21 : B=17 Else A=17 : B=21 Ink A : Draw X,Y To XX-1,Y : Draw X,Y To X,YY Ink B : Draw X+1,YY To XX,YY : Draw XX,Y To XX,YY End Proc Procedure _WAIT[N] N=N*50 Clear Key While Joy(1)+Asc(Inkey$)+Mouse Key : Wend A=Timer Repeat If N Then Exit If Timer-A=N Until Joy(1)+Asc(Inkey$)+Mouse Key Clear Key End Proc Procedure _C0 For I=0 To 32 Colour I,0 Next End Proc Procedure _I[N$] Do Screen Copy 0,171,52,287,61 To 1,102,200 _T[158-(Len(N$)*5)/2,202,N$+"#",0] Clear Key N=Wait Loop Exit If N=13 If N>31 and N<123 and Len(N$)<21 N$=N$+Upper$(Chr$(N)) Else If N=8 and Len(N$)>0 N$=Left$(N$,Len(N$)-1) End If Loop _T[158-(Len(N$)*5)/2,202,N$+" ",0] End Proc[N$] '* Procedure _E01 '* 1 Neuen Zug (11) N=XP-1 Add XM(N),2 XM(N)=Min(999,XM(N)) _O["GET 1 EXTRA MOVE"] End Proc Procedure _E02 '* 2 Neue Züge (12) N=XP-1 Add XM(N),3 XM(N)=Min(999,XM(N)) _O["GET 2 EXTRA MOVES"] End Proc Procedure _E03 '* 3 Neue Züge (13) N=XP-1 Add XM(N),4 XM(N)=Min(999,XM(N)) _O["GET 3 EXTRA MOVES"] End Proc Procedure _E04 '* 4 Neue Züge (14) N=XP-1 Add XM(N),5 XM(N)=Min(999,XM(N)) _O["GET 4 EXTRA MOVES"] End Proc '** Procedure _E05 '* 10 Neue Sek. (15) N=XP-1 If XT(N)<0 Then Pop Proc Add XT(N),10 XT(N)=Min(999,XT(N)) _O["GET 10 BONUS SECONDS"] End Proc Procedure _E06 '* 15 Neue Sek. (16) N=XP-1 If XT(N)<0 Then Pop Proc Add XT(N),15 XT(N)=Min(999,XT(N)) _O["GET 15 BONUS SECONDS"] End Proc Procedure _E07 '* 20 Neue Sek. (17) N=XP-1 If XT(N)<0 Then Pop Proc Add XT(N),20 XT(N)=Min(999,XT(N)) _O["GET 20 BONUS SECONDS"] End Proc Procedure _E08 '* Teleporting (18) For A=0 To 7 For B=0 To 7 If XF(A,B)=0 N=True Exit 2 End If Next Next If Not N Then Pop Proc _O["WHUI... TELEPORTING"] Repeat A=Rnd(7) B=Rnd(7) Until XF(A,B)=0 X=X Bob(4+XP) Y=Y Bob(4+XP) XF(X/24,Y/24)=0 XF(A,B)=XP Bob Off 4+XP : Wait Vbl Bob 3,X,Y,62 : Amal 3,XA$(5) : Amal On 3 : Wait Vbl If XMUSIC=2 Then Sam Play %11,4 While Chanan(3) : Wend Bob 3,21+A*24,21+B*24,62 : Amal 3,XA$(5) : Amal On 3 : Wait Vbl If XMUSIC=2 Then Sam Play %11,4 While Chanan(3) : Wend Bob 4+XP,21+A*24,21+B*24,41+(XP-1)*4+Rnd(3) : Wait Vbl Bob Off 3 : Wait Vbl End Proc Procedure _E09 '* Alle Kugeln aneignen (19) _O["GET ALL BALLS"] N=XP-1 A=XK(0)+XK(1)+XK(2)+XK(3)-XK(N) Repeat X=Rnd(7) Y=Rnd(7) B=XF(X,Y) If B>4 and B<9 and B<>XP+4 Dec A _CHANGEBALL[X,Y] End If Until A=0 End Proc Procedure _E10 '* Alle Kugeln zu Hindernis (20) _O["ALL BALLS TO STONE"] N=XP-1 Colour 14,Colour(21) Colour 12,Colour(22) Colour 31,Colour(15) Repeat X=Rnd(7) Y=Rnd(7) If XF(X,Y)=XP+4 Dec XK(N) XF(X,Y)=9 X=21+X*24 Y=21+Y*24 Paste Icon X-7,Y-7,6 : Wait Vbl Bob 3,X,Y,62 Amal 3,XA$(5) Amal On 3 If XMUSIC=2 Sam Play %11,4 End If Wait Vbl While Chanan(3) : Wend Bob Off 3 Bob 2,X+1,Y+1,57 Amal 2,XA$(4) Amal On 2 Wait Vbl While Chanan(2) : Wend Paste Icon X-7,Y-7,5 : Wait Vbl Bob Off 2 : Wait Vbl End If Until XK(N)=0 End Proc '*** Procedure _E11 '* Alle Kugeln löschen (21) _O["LOOSING ALL BALLS"] N=XP-1 Repeat X=Rnd(7) Y=Rnd(7) If XF(X,Y)=XP+4 Dec XK(N) XF(X,Y)=0 X=21+X*24 Y=21+Y*24 Paste Icon X-7,Y-7,6 : Wait Vbl Bob 3,X,Y,62 Amal 3,XA$(5) Amal On 3 If XMUSIC=2 Sam Play %11,4 End If Wait Vbl While Chanan(3) : Wend Bob Off 3 End If Until XK(N)=0 End Proc Procedure _E12 '* Ende (22) XM(XP-1)=1 _PLAYEROFF End Proc Procedure _E13 '* Sekunden verlust (23) A=Rnd(4)+1 _O["LOOSING"+Str$(A)+" SECONDS"] N=XP-1 Add XT(N),-A XT(N)=Max(0,XT(N)) End Proc Procedure _E14 '* Max. 3 Züge weniger (24) A=Rnd(2)+1 _O["LOOSING"+Str$(A)+" MOVES"] N=XP-1 Add XM(N),-A XM(N)=Max(0,XM(N)) End Proc '**** Procedure _E15 '* Zufall (25) N=Rnd(13)+1 On N Proc _E01,_E02,_E03,_E04,_E05,_E06,_E07,_E08,_E09,_E10,_E11,_E12,_E13,_E14 End Proc