!*************************************************************************
!** BELLFRUIT SIMULATOR BY : W HARTGERS / OMEGON COMPUTERSYSTEMS *
!** HOLLAND *
!** *
!** Sorry folks, the inside text of this program has to be translated *
!** to your language. It's a bell-fruit simulator with hold-facility *
!** and bonus-point. There is one bug in the program: the last bonus- *
!** point is not giving. I don't have time to fix it. Maybe some other? *
!** When done, let me know please! (Via the mailbox system - WYCH/AM) *
!** The routines used within this program are PACMAN.SBR (Also on the *
!** network) and VERIFY.SBR (on the network also). *
!** *
!** Ofcause the normal rules are here also: Let the author message in *
!** the program and my employer has NOTHING to do with this program *
!** It's for free... *
!** *
!** This program is working OK on an AM62A terminal, don't know the *
!** the result when using another terminal. It should be ease to modify. *
!** *
!** Have fun with the program and hope we'll meet again *
!** *
!** When you enjoy it, please let me know via the mailbox of AMUS! *
!** *
!*************************************************************************
RANDOMIZE
STRSIZ 50
PRINT "FRUIT By W Hartgers / Arnhem (HOLLAND)"
FOR I=1 TO 500 : NEXT I
DIM BAR$(15)
DIM TXT1$(30)
MAP1 T$,S,45
PRINT TAB(-1,29);
XCALL VERIFY,"PACMAN.SBR"
XCALL PACMAN
BAR$(01) ="KERS *1"
BAR$(02) ="PEER 2"
BAR$(03) ="KLOK *3"
BAR$(04) ="B A R 4"
BAR$(05) ="OMEGON*5"
BAR$(06) ="APPEL 6"
BAR$(07) ="KERS *1"
BAR$(08) ="KLOK 3"
BAR$(09) ="APPEL *6"
BAR$(10) ="PEER 2"
BAR$(15) ="KERS *1"
BAR$(11) ="OMEGON*5"
BAR$(12) ="APPEL 6"
BAR$(13) ="KERS *1"
BAR$(14) ="B A R 4"
A1:
READ TXT1$
IF TXT1$="END" GOTO A2
MES1=MES1+1
TXT1$(MES1)=TXT1$
GOTO A1
A2:
INPUT "Instruktie j/n : ",I$
I$=UCS(I$)
IF I$="J" GOSUB HELP
BEG:
PRINT TAB(-1,0);TAB(-1,36);
PRINT TAB(-1,23)
PRINT TAB(01,01);"2";
FOR I=1 TO 78
PRINT "<";
NEXT I
PRINT TAB(01,80);"3";
FOR I=2 TO 09
PRINT TAB(I,1);">";
PRINT TAB(I,80);">";
NEXT I
! PRINT TAB(-1,24);TAB(12,03);"DOOR W HARTGERS / OMEGON";TAB(-1,23);
PRINT TAB(18,3);"2::::::::::::::::::::::::::::::::::::3";
PRINT TAB(19,3);"6 6";
PRINT TAB(20,3);"6 6";
PRINT TAB(21,3);"4::::::::::::::0::::::::::::0::::::::9";
PRINT TAB(22,3);"6 6 6 6";
PRINT TAB(23,3);"=<<<<<<<<<<<<<<=<<<<<<<<<<<<=<<<<<<<<=";
PRINT TAB(-1,24);TAB(22,4);"SPELEN:";TAB(22,20);"BONUS: ";
PRINT TAB(22,32);"WIN:";
IF SWHELP=0 THEN SPEL =15
IF SWHELP=0 THEN BONUS =00
GOSUB NUMBERS
IF SWHELP=0 THEN SWVAST =0
IF SWHELP=0 THEN GOSUB INIT : SWVAST=1
GOSUB DISPL
PRINT TAB(22,37);" ";
PRINT TAB(11,48);"OMEGON OMEGON OMEGON 10 BONUS"
PRINT TAB(12,48);"B A R B A R B A R 5 BONUS"
PRINT TAB(13,48);"KLOK KLOK KLOK 5 BONUS"
PRINT TAB(14,48);"PEER PEER PEER 20";
PRINT TAB(15,48);"APPEL APPEL APPEL 20";
PRINT TAB(16,48);"KERS KERS KERS 10";
PRINT TAB(17,48);"OMEGON OMEGON - 10";
PRINT TAB(18,48);"B A R B A R - 10";
PRINT TAB(19,48);"KERS KERS - 4";
PRINT TAB(21,48);"Bij bonus geldt elke ster voor";
PRINT TAB(22,48);"20 punten ";
IF SWVALS=1 THEN PRINT TAB(22,70);"VALS";
IF SWHELP=0 THEN SWSIL=1
T$=" 2 3 4 "
PRINT TAB(22,36);:PRINT " ";
PRINT TAB(19,5);"GAMBLE: x ";T$;" of P(ak)";TAB(-1,37);
BEGIN:
BEGX:
GOSUB ACCEPT
PRINT TAB(-1,29);
IF SWAUT=0 THEN SPEL=SPEL-1
SWX=0 : IF BONUS=1 THEN SWX=1
SWF=0
GOSUB NUMBERS
GOSUB ROLL
IF SWAUT=1 THEN FOR DEL=1 TO 10000 : NEXT DEL
GOSUB WINNING
GOSUB NUMBERS
IF BONUS <>0 THEN BONUS=BONUS-1
PRINT TAB(22,36);:PRINT " ";
SWVAST =0
IF VAST1=1 OR VAST2=1 OR VAST3=1 THEN SWVAST=1
IF WIN<>0 THEN SWVAST=1
IF SPEL=0 GOTO EIND
GOTO BEGIN
ROLL:
PRINT TAB(24,01);SPACE(60);
F=RND : F1=INT(F*15)
IF F1>3 GOTO ROLLA
XTXT=RND : YTXT=INT(XTXT*MES1)
IF YTXT < 1 GOTO ROLLA
IF YTXT > MES1 GOTO ROLLA
T$=TXT1$(YTXT)
PRINT TAB(24,01);TAB(-1,21);
FOR XT=1 TO LEN(T$)
PRINT T$[XT;1];" ";
FOR XTT=1 TO 600 : NEXT XTT
NEXT XT
PRINT TAB(24,65);TAB(-1,22);" ";
FOR XTT=1 TO 2000 : NEXT XTT
ROLLA:
DD=10
A=RND:AA=INT(A*40) : IF AA<4 GOTO ROLL
IF VAST2 = 1 AND VAST3 = 1 THEN AA=AA*3
IF VAST2 = 1 AND VAST3 <> 1 THEN AA=AA*2
IF VAST2 <> 1 AND VAST3 = 1 THEN AA=AA*2
IF VAST1=1 AND VAST2=1 AND VAST3=1 THEN RETURN
FOR I=1 TO AA
IF TIME<>OT GOSUB TIM
DD=DD+15
IF VAST1<>1 THEN ROL1=ROL1+1 : IF ROL1>15 THEN ROL1=1
PRINT TAB(14,6);BAR$(ROL1)[1;6];
IF VAST2<>1 THEN ROL2=ROL2+1 : IF ROL2>15 THEN ROL2=1
PRINT TAB(14,19);BAR$(ROL2)[1;6];
IF VAST3<>1 THEN ROL3=ROL3+1 : IF ROL3>15 THEN ROL3=1
PRINT TAB(14,32);BAR$(ROL3)[1;7];
NEXT I
IF SWSIL=0 THEN PRINT CHR$(7);
IF VAST2=1 AND VAST3=1 THEN RETURN
ROLL2:
A=RND:AA=INT(A*10) : IF AA<3 GOTO ROLL2
FOR I=1 TO AA
IF TIME<>OT GOSUB TIM
DD=DD+30
IF VAST2<>1 THEN ROL2=ROL2+1 : IF ROL2>15 THEN ROL2=1
PRINT TAB(14,19);BAR$(ROL2)[1;6];
B=RND : BB=INT(B*10) : IF INT(BB/2)=BB/2 THEN GOTO ROLL2A
IF SPEL<25 GOTO ROLL2A
IF BAR$(ROL1)[1;8]<>BAR$(ROL2)[1;8] GOTO ROLL2A
IF ROL2=15 THEN ROL2=1 ELSE ROL2=ROL2+1
PRINT TAB(14,19);BAR$(ROL2)[1;6];
ROLL2A:
IF VAST3<>1 THEN ROL3=ROL3+1 : IF ROL3>15 THEN ROL3=1
PRINT TAB(14,32);BAR$(ROL3)[1;7];
FOR Y=1 TO DD : NEXT Y
IF TIME<>OT GOSUB TIM
NEXT I
IF SWSIL=0 THEN PRINT CHR$(7);
IF VAST3=1 THEN RETURN
ROLL3:
A=RND:AA=INT(A*5) : IF AA<3 GOTO ROLL3
FOR I=1 TO AA
IF TIME<>OT GOSUB TIM
DD=DD+30
IF VAST3<>1 THEN ROL3=ROL3+1 : IF ROL3>15 THEN ROL3=1
PRINT TAB(14,32);BAR$(ROL3)[1;7];
FOR Y=1 TO DD : NEXT Y
IF TIME<>OT GOSUB TIM
NEXT I
IF SWSIL=0 THEN PRINT CHR$(7);
RETURN
INIT:
A=RND : AA=INT(A*16) : IF AA<1 GOTO INIT
IF AA>15 GOTO INIT
ROL1=AA
INIT2:
A=RND : AA=INT(A*16) : IF AA<1 GOTO INIT2
IF AA>15 GOTO INIT2
ROL2=AA
INIT3:
A=RND : AA=INT(A*16) : IF AA<1 GOTO INIT3
IF AA>15 GOTO INIT3
ROL3=AA
RETURN
ACCEPT:
PRINT TAB(17,40);TAB(-1,35);
VAST1=0 : VAST2=0 : VAST3=0
IF SWVAST=1 THEN PRINT TAB(17,03);&
" ";:&
PRINT TAB(24,65);:GOTO ACC2
PRINT TAB(-1,23);
PRINT TAB(17,05);TAB(-1,21);TAB(-1,49);TAB(-1,49);&
TAB(-1,49);TAB(-1,49);TAB(-1,49);TAB(-1,49);TAB(-1,22);
PRINT TAB(17,18);TAB(-1,21);TAB(-1,49);TAB(-1,49);&
TAB(-1,49);TAB(-1,49);TAB(-1,49);TAB(-1,49);TAB(-1,22);
PRINT TAB(17,31);TAB(-1,21);TAB(-1,49);TAB(-1,49);&
TAB(-1,49);TAB(-1,49);TAB(-1,49);TAB(-1,49);TAB(-1,22);
PRINT TAB(-1,24);TAB(24,65);
ACC2:
IF TIME<>OT GOSUB TIM
XCALL PACMAN,P$: IF LEN(P$)=0 AND SWAUT=0 GOTO ACC2
IF P$=CHR$(27) THEN PRINT TAB(-1,28);TAB(-1,0);:GOTO EINDE
IF P$=CHR$(13) THEN PRINT TAB(-1,29);TAB(24,65);:RETURN
IF P$=CHR$(185) GOSUB HELP : SWHELP=1 : GOTO BEG
P$ =UCS(P$)
IF P$="S" AND SWSIL=0 THEN SWSIL=1 : PRINT TAB(22,78);" "; ELSE&
IF P$="S" AND SWSIL=1 THEN SWSIL=0 : PRINT TAB(22,78);"S";
IF P$="A" AND SWAUT=0 THEN SWAUT=1 : PRINT TAB(22,77);"A"; ELSE&
IF P$="A" AND SWAUT=1 THEN SWAUT=0 : PRINT TAB(22,77);" ";
IF SWAUT=1 THEN RETURN
IF P$="@" THEN SPEL=SPEL+10 : SWVALS=1 :&
PRINT TAB(22,70);"VALS";
IF SWVAST=1 GOTO ACC2
IF P$="C" THEN GOTO ACCEPT
IF P$<"1" OR P$>"3" GOTO ACC2
IF P$="1" THEN VAST1=1: PRINT TAB(17,05);" "; : GOTO ACC2
IF P$="2" THEN VAST2=1: PRINT TAB(17,18);" "; : GOTO ACC2
IF P$="3" THEN VAST3=1: PRINT TAB(17,31);" "; : GOTO ACC2
GOTO ACC2
NUMBERS:
PRINT TAB(22,11);:PRINT USING "####";SPEL;
PRINT TAB(22,26);:PRINT USING "####";BONUS;
RETURN
WINNING:
PRINT TAB(22,36);" ";
XX$=""
XX$=BAR$(ROL1)[8;1]+BAR$(ROL2)[8;1]+BAR$(ROL3)[8;1]
BON=0:PNT=0:WIN=0
IF XX$="555" THEN BON=10:GOSUB FLASH: GOTO WIN5
IF XX$="444" THEN BON=5 :GOSUB FLASH: GOTO WIN5
IF XX$="333" THEN BON=5 :GOSUB FLASH: GOTO WIN5
IF (BONUS <> 0 OR SWX=1) AND BAR$(ROL3)[7;1]="*" THEN PNT=20 : GOTO WIN5
IF XX$="666" THEN PNT=20: GOTO WIN5
IF XX$="222" THEN PNT=20: GOTO WIN5
IF XX$="111" THEN PNT=10: GOTO WIN5
IF XX$[1;2]="55" THEN PNT=10 : GOTO WIN5
IF XX$[1;2]="44" THEN PNT=10: GOTO WIN5
IF XX$[1;2]="11" THEN PNT=4 : GOTO WIN5
GOTO WIN90
WIN5:
IF PNT=0 GOTO WIN10
IF BONUS<1 AND SWAUT=0 GOSUB GAMBLE
IF PNT=0 GOTO WIN10
WIN=1
FOR XXXX=SPEL TO SPEL+PNT-1
IF TIME<>OT GOSUB TIM
PRINT TAB(22,11);:PRINT USING "####";XXXX;
FOR Y=1 TO 800 : NEXT Y
NEXT XXXX
SPEL =XXXX
GOTO WIN90
WIN10:
IF BON=0 GOTO WIN90
WIN=1
FOR XXXX=BONUS TO BONUS+BON-1
IF TIME<>OT GOSUB TIM
PRINT TAB(22,26);:PRINT USING "####";XXXX;
FOR Y=1 TO 800 : NEXT Y
NEXT XXXX
BONUS =XXXX
WIN90:
RETURN
FLASH:
FOR II=1 TO BON*2
IF TIME<>OT GOSUB TIM
PRINT TAB(24,70);TAB(-1,36);
FOR Y=1 TO 380 : NEXT Y
PRINT TAB(24,70);TAB(-1,37);
FOR Y=1 TO 480 : NEXT Y
NEXT II
RETURN
GAMBLE:
T$=" 2 3 4 " : TX$=T$:P=0
PRINT TAB(22,36);:PRINT USING "####";PNT;
PRINT TAB(19,5);"GAMBLE: x ";T$;" of P(ak)";
GAM1:
P=P+1 : IF P=13 THEN P=1
PRINT TAB(20,14);
XCALL PACMAN,POS$
IF LEN(POS$)<>0 GOTO GAM5
PRINT SPACE(P);TAB(-1,23);"!";TAB(-1,24);SPACE(12);
GOTO GAM1
GAM5:
IF POS$=CHR$(27) THEN PRINT TAB(-1,28);TAB(-1,0);:GOTO EINDE
IF POS$=CHR$(13) GOTO GAM8
IF POS$="P" OR POS$="p" GOTO GAM9
GOTO GAM1
GAM8:
LX=RND : LY=INT(LX*50)
FOR LX=1 TO LY
IF TIME<>OT GOSUB TIM
P=P+1 : IF P=13 THEN P=1
PRINT TAB(20,14);
PRINT SPACE(P);TAB(-1,23);"!";TAB(-1,24);SPACE(12);
FOR DEL=1 TO LX*10
NEXT DEL
NEXT LX
IF T$[P;1]=" " THEN PNT=0 : GOTO GAM85
WW=VAL(T$[P;1])
PNT=PNT*WW
FOR L=1 TO 5000
NEXT L
GOTO GAMBLE
GAM85:
PRINT TAB(22,36);:PRINT " ";
GAM9:
WIN=1
RETURN
EIND:
PRINT TAB(24,1);TAB(-1,28);
PRINT "Sorry, geen punten meer. Het was leuk met U te ";
PRINT "spelen! - Druk enter : ";TAB(-1,9);
INPUT "",J
GOTO EINDE
HELP:
PRINT TAB(-1,36);
PRINT TAB(-1,0);TAB(-1,30);
PRINT "BELL-FRUIT door W Hartgers / Omegon"; TAB(-1,31)
PRINT "Dit programma simuleert een fruit-machine. "
PRINT "De volgende toetsen worden gebruikt : "
PRINT "RETURN - Start draaien van de 'rollen' of bij gokken"
PRINT " stoppen van het pijltje."
PRINT "1/2/3 - Met deze toetsen kunnen, indien de blokjes onder"
PRINT " de 'rollen' knipperen een of meerdere toetsen"
PRINT " vastgezet worden."
PRINT "C - De vastgezette toetsen weer vrijgeven"
PRINT "ESC - Tussentijds stoppen van het spel"
PRINT "A - Automatisch aan/uit (DEMO) "
PRINT " "
PRINT "De te behalen waardes zijn op het scherm zichtbaar."
PRINT "Bij alle normale winsten is het mogelijk om te gokken op"
PRINT "een hogere winst (x 1, 2, 3 of 4)."
PRINT "Helaas loopt het pijltje altijd iets door, maar niet altijd"
PRINT "even ver, zodat het echt gokken is."
PRINT "Bij bonuspunten zijn per ster in de laaste 'rol' 20 punten"
PRINT "te verdienen. Theoretisch is het dus mogelijk om na"
PRINT "OMEGON OMEGON OMEGON 200 punten te verdienen."
PRINT "Bij bonus-winsten is het niet mogelijk om te gokken"
PRINT " "
PRINT TAB(-1,37);
PRINT "Druk op ENTER indien gezien : "; : INPUT I$
PRINT TAB(-1,36);
PRINT TAB(3,1);TAB(-1,10);
PRINT " "
PRINT "Dit programma is een NIET ge-support produkt;"
PRINT "derhalve is men vrij om het te gebruiken, maar "
PRINT "de juiste werking wordt niet gegarandeerd!"
PRINT " "
PRINT "Dit programma werkt niet onder MULTI en"
PRINT "ook niet op een MS/DOS PC onder OMATE"
PRINT " "
PRINT TAB(-1,37);
PRINT "Druk op ENTER indien gezien : "; : INPUT I$
RETURN
DATA1:
DATA "Nieuwe ronde; Nieuwe kansen !"
DATA "He're we go again!"
DATA "Plop, Plop, Plop!"
DATA "Draaien met die hap!"
DATA "Spanning en sensatie"
DATA "The pink panther strikes again"
DATA "Leve de LOL!"
DATA "Aaaaaarch"
DATA "In de hemel is geen bier!"
DATA "Ik wil op vakantie!"
DATA "Dit gaat geld kosten !"
DATA "Moet je niet aan't werk?"
DATA "END"
TIM:
OT=TIME: PRINT TAB(24,70);
UU=0 : MM=0 : SS=0
TIM1: IF OT > 3599 THEN UU=UU+1 : OT=OT-3600 : GOTO TIM1
TIM2: IF OT > 60 THEN MM=MM+1 : OT=OT-60 : GOTO TIM2
SS=OT
PRINT USING "#Z";UU; : PRINT ":";
PRINT USING "#Z" ;MM; : PRINT ":";
PRINT USING "#Z";SS;
OT=TIME
RETURN
