!*! Updated on 26-Aug-93 at 4:13 PM by Sharon L. Greene; edit time: 0:08:06
!*************************** AMUS Program Label ******************************
! Filename: D5000.RUN Date: 8/12/91
! Category: GAME Hash Code: 615-441-451-605 Version: 2.2
! Initials: low/AM Name: David Krecklow
! Company: Compu-Center Co., Inc. Telephone #: 8053251004
! Related Files: D5000.BAS, D5000.HLP, D5000.CMD
! Min. Op. Sys.: ANY Expertise Level: BEG
! Special: N
! Description: Uses ACCEPT.SBR, NOECHO.SBR & SLEEP.SBR
! A Dice Game (see D5000.HLP for explination)
!
!*****************************************************************************
SIGNIFICANCE 11
! ***********************************************************************
! * *
! * ******** **** **** **** * *
! * * **** * * * * * * * *
! * ** ** * * * * * * * *
! * ** * * * * * * *
! * ****** **** **** **** * *
! * *
! ***********************************************************************
!
! A COMPUTER DICE GAME by David Krecklow 01/01/1984
! 805/325-1004
!
! This game may not be copied or reproduced in any
! manner for sale without permission of the author.
!
! Donated to AMUS 08/13/91
!============================================================
!
START:
? TAB(-1,0);"5 0 0 0 - A COMPUTER DICE GAME by David Krecklow"
? TAB(3,1);"Enter the number of players (up to six) ";
XCALL ACCEPT,ENTRY
X$=CHR(ENTRY)
NOP=VAL(X$)
? NOP;
IF NOP<1 OR NOP>6 THEN ? CHR(7); : GOTO START
!===============================================
!
NAMES:
? TAB(3,1);TAB(-1,9);"Now enter the names of each Player "
NMCTL=0
FOR I= 1 TO NOP
NAM0:
? TAB(I+4,10);"Player #";I;"__________"
FOR K=1 TO 10
NAM1:
? TAB(I+4,K+20);
XCALL ACCEPT,ENTRY
X=ENTRY
IF X=13 THEN K=10 : GOTO NAM2
IF X=127 AND K>1 THEN K=K-1 : PLNAM(I)[K,K]="" : &
? TAB(I+4,K+20);"_";TAB(I+4,K+20); : GOTO NAM1
IF X=127 AND K=1 THEN GOTO NAM1
IF X<32 OR X>126 THEN ? CHR(7); : GOTO NAM1
? TAB(I+4,K+20);CHR(X);
PLNAM(I)[K,K]=CHR(X)
NAM2:
NEXT K
X=(9-INT(LEN(PLNAM(I))))/2 : X=INT(X)
NM=PLNAM(I)
IF X>0 THEN PLNAM(I)=SPACE(X)+NM+SPACE(10)
ON NMCTL GOTO NMCNG
NEXT I
NMCNG:
NMCTL=1
? TAB(23,1);TAB(-1,9);"Player number to change or 'RET' > ";
XCALL ACCEPT,ENTRY : I=ENTRY
IF I>48 AND I<55 THEN I=I-48 : PLNAM(I)="" : GOTO NAM0
?
? "This game is played by rolling five dice at the start of each TURN"
? " A TURN consists of one or more ROLLS, you may keep rolling "
? " as long as you score with at least one di"
? "If you score you may pick up the non-scoring dice or take your points"
? " You may also pick up dice that score on each roll as long as you"
? " leave at least 50 points on each roll"
?
? "Scores requiring more than one di must all be in one roll"
? " Five of a kind wins the game "
? " Straights (1-5 or 2-6) score 1500"
? " Three ones scores 1000"
? " Three of anything else scores that number times 100"
? "Ones not included in other combinations score 100, fives score 50"
?
? "You must score ";MSOB;" to get on the board the first time "
? "Enter the number of the dice to pick up after your roll"
? " Non-scoring dice will be picked-up automatically"
? "Enter a 'S' to stop your turn and take your score or RETURN to roll again"
? "If all five dice score after one or more rolls they will all roll again"
? " and you may continue your turn till you stop or fail to score"
? "If none of the dice rolled scores you lose your points for that turn"
? " and the next player rolls"
? " 5000 wins the game - each player gets one more turn to top the winner"
? "PRESS RETURN to start the game >";
XCALL ACCEPT,ENTRY
!============================================================
!
SCREEN:
? TAB(-1,0)
? TAB(-1,23);
FOR L=1 TO 13
FOR T=1 TO NOP
? TAB(-1,11);TAB(-1,47);TAB(-1,12);SPACE(11);
? TAB(-1,11);TAB(-1,47);TAB(-1,12);
NEXT T
?
NEXT L
? TAB(-1,13);TAB(1,1);
FOR T=1 TO NOP
? TAB(-1,11);TAB(-1,47);" ";TAB(-1,12);TAB(-1,24); &
PLNAM(T);TAB(-1,23);TAB(-1,11);TAB(-1,47);TAB(-1,12);
NEXT T
FOR T=1 TO NOP
? TAB(2,((T*13)-12));TAB(-1,44);
? TAB(-1,11);
FOR L=1 TO 11
? TAB(-1,46);
NEXT L
? TAB(-1,43);
? TAB(-1,12);
NEXT T
FOR T=1 TO NOP
? TAB(13,((T*13)-12));TAB(-1,44);
? TAB(-1,11);
FOR L=1 TO 11
? TAB(-1,46);
NEXT L
? TAB(-1,43);
? TAB(-1,12);
NEXT T
FOR T=1 TO NOP
? TAB(15,((T*13)-12));TAB(-1,40);
? TAB(-1,11);
FOR L=1 TO 11
? TAB(-1,46);
NEXT L
? TAB(-1,41);
? TAB(-1,12);
NEXT T
? TAB(-1,24);
!============================================================
!
! MAIN LOOP FOR PLAY
!
UP:
FOR PLR=1 TO NOP
IF LAST=PLR THEN PLR=10 : GOTO EUP
CALL CLEAR'DICE
? TAB(16,1);TAB(-1,10);TAB(PLR*12-8+PLR-1)"UP ^";
RCTL=0
? TAB(17,1);TAB(-1,9);"RETURN to roll.....";
XCALL ACCEPT,ENTRY
CALL ROLL ! return @ end'roll
IF RCTL=0 AND LAST<1 THEN GOTO TUFF
IF RCTL=0 AND LAST>0 THEN GOTO REAL'TUFF
EUP:
NEXT PLR
IF PLR>9 THEN GOTO DONE
GOTO UP
!=================================================================
! ROLL THE DICE
!
ROLL:
XD=NOD
NXT'ROLL:
RCTL=0
? TAB(17,1);TAB(-1,10);
FOR R=1 TO XD
DI(R)=INT(6*RND(0)+1)
DICTL(R)=0
IF DI(R)=1 THEN NO1=NO1+1 : IF RCTL<2 THEN RCTL=RCTL+1
IF DI(R)=2 THEN NO2=NO2+1
IF DI(R)=3 THEN NO3=NO3+1
IF DI(R)=4 THEN NO4=NO4+1
IF DI(R)=5 THEN NO5=NO5+1 : IF RCTL<2 THEN RCTL=RCTL+1
IF DI(R)=6 THEN NO6=NO6+1
NEXT R
RANDOMIZE
!=================================================================
! DISPLAY DICE
!
CALL CLEAR'DICE
? TAB(-1,23);TAB(-1,29);
FOR CL=1 TO XD
SPIN=CL
CALL SPIN'DICE
FOR R=1 TO 5
IF R=1 THEN ? TAB(16+R,CL*8);TAB(-1,38); &
TAB(-1,46);TAB(-1,46);TAB(-1,46);TAB(-1,46);TAB(-1,46); &
TAB(-1,39); : GOTO NXT'R
IF R=5 THEN ? TAB(16+R,CL*8);TAB(-1,40); &
TAB(-1,46);TAB(-1,46);TAB(-1,46);TAB(-1,46);TAB(-1,46); &
TAB(-1,41); : GOTO NXT'R
? TAB(16+R,CL*8);TAB(-1,47);" ";TAB(-1,24); &
(XX(DI(CL))[((R-1)*3-2);3]);TAB(-1,23); &
" ";TAB(-1,47);
NXT'R:
NEXT R
NEXT CL
? TAB(-1,24);TAB(-1,28);
!=================================================================
! CHECK SCORE
!
IF NO1=5 OR NO2=5 OR NO3=5 OR NO4=5 OR NO5=5 OR NO6=5 THEN GOTO FIVE
IF (NO1>0 AND NO2>0 AND NO3>0 AND NO4>0 AND NO5>0) OR &
(NO2>0 AND NO3>0 AND NO4>0 AND NO5>0 AND NO6>0) THEN CALL STRGHT
IF (NO1>2 OR NO2>2 OR NO3>2 OR NO4>2 OR NO5>2 OR NO6>2) THEN CALL THREE
IF RCTL=0 THEN GOTO END'ROLL
SCORE=SCORE+(NO1*100)+(NO5*50)
CALL DISP'SCR
SCORE:
FOR I=1 TO XD
? TAB(22,I*8+4);I USING "#";
IF DICTL(I)=3 THEN ? "*";
NEXT I
CXD=XD
IF RCTL>=3 THEN CXD=CXD-RCTL
CXD=CXD-NO1-NO5
IF CXD<1 THEN ? TAB(21,51);SPACE(25);TAB(-1,35); &
TAB(21,50);TAB(-1,34);" ALL DICE MAY ROLL AGAIN ";TAB(-1,35);
IF XD>1 THEN IF RCTL>1 AND RCTL<5 THEN CALL PICK'UP
IF LAST<>0 THEN IF SCORE+TOTAL+GT(PLR)<=WIN'SCR THEN &
? TAB(23,1);TAB(-1,10);"You must beat ";WIN'SCR;" RETURN to roll..."; : &
XCALL ACCEPT,ENTRY : RL=0 : GOTO SCR1
IF LAST<>0 THEN IF SCORE+TOTAL+GT(PLR)>WIN'SCR THEN CALL NEW'WINR : &
GT(PLR)=SCORE+TOTAL+GT(PLR) : &
XCALL ACCEPT,ENTRY : RL=0 : GOTO SCR1
SCR0:
? TAB(23,1);TAB(-1,10);"RETURN to roll again or 'S' to stop ";
XCALL ACCEPT,ENTRY : RL=ENTRY
IF RL=27 THEN GOTO SCORE
IF RL<>13 AND RL<>83 AND RL<>115 THEN GOTO SCR0
SCR1:
IF RCTL>=3 THEN XD=XD-RCTL
XD=XD-NO1-NO5
NO1=0 : NO2=0 : NO3=0 : NO4=0 : NO5=0 : NO6=0
IF XD<1 THEN XD=NOD
TOTAL=TOTAL+SCORE
SCORE=0
? TAB(21,50);TAB(-1,35);
IF RL<>83 AND RL<>115 THEN GOTO NXT'ROLL
!============================================================
!
END'ROLL:
IF RCTL<>0 THEN IF (TOTAL+GT(PLR))<MSOB THEN ? TAB(23,1);TAB(-1,9); &
CHR(7);"You are below the minimum score. You must score "; &
MSOB;" or higher to stop "; : &
XCALL ACCEPT,ENTRY : GOTO NXT'ROLL
NO1=0 : NO2=0 : NO3=0 : NO4=0 : NO5=0 : NO6=0
IF RCTL<>0 THEN GT(PLR)=GT(PLR)+TOTAL
IF RCTL<>0 THEN IF PLRROW(PLR)>9 THEN CALL CLEAR'COL
IF RCTL<>0 THEN PLRROW(PLR)=PLRROW(PLR)+1 : &
? TAB(PLRROW(PLR)+2,PLR*13-9);TOTAL USING "######"
TOTAL=0
? TAB(14,PLR*13-9);GT(PLR) USING "######"
IF LAST=0 THEN IF GT(PLR)>4999 THEN CALL OVER'FIVE
RETURN
!============================================================
!
PICK'UP:
? TAB(23,1);TAB(-1,10);"ENTER the number of the di to reroll ";
XCALL ACCEPT,ENTRY : PK=ENTRY
IF PK=13 THEN RETURN
X$=CHR(PK) : PK=VAL(X$)
IF PK<1 OR PK>5 THEN GOTO PICK'UP
IF PK>XD THEN ? TAB(24,1);CHR(7);"1 to ";XD;" "; : XCALL ACCEPT,ENTRY : &
PK=ENTRY : GOTO PICK'UP
IF DICTL(PK)=9 THEN ? TAB(24,1);CHR(7);"YOU HAVE PICKED THAT "; &
"ONE BEFORE "; : XCALL ACCEPT,ENTRY : GOTO PICK'UP
IF DICTL(PK)=3 THEN GOTO PICK'UP'THREE
IF DI(PK)=1 THEN GOTO PICK'UP'ONE
IF DI(PK)=5 THEN GOTO PICK'UP'FIVE
? TAB(22,PK*8+4);" ";
GOTO PICK'UP
PICK'UP'ONE:
SCORE=SCORE-100
IF SCORE<50 THEN ? TAB(23,1);TAB(-1,10);CHR(7); &
"YOU MUST KEEP AT LEAST 50 POINTS ON EACH ROLL "; : &
XCALL ACCEPT,ENTRY : SCORE=SCORE+100 : GOTO PICK'UP
NO1=NO1-1
DICTL(PK)=9
? TAB(22,PK*8+4);" ";
CALL DISP'SCR
GOTO PICK'UP
PICK'UP'FIVE:
SCORE=SCORE-50
IF SCORE<50 THEN ? TAB(23,1);TAB(-1,10);CHR(7); &
"YOU MUST KEEP AT LEAST 50 POINTS ON EACH ROLL "; : &
XCALL ACCEPT,ENTRY : SCORE=SCORE+50 : GOTO PICK'UP
NO5=NO5-1
DICTL(PK)=9
? TAB(22,PK*8+4);" ";
CALL DISP'SCR
GOTO PICK'UP
PICK'UP'THREE:
MINUS=100*DI(PK)
IF DI(PK)=1 THEN MINUS=1000
SCORE =SCORE-MINUS
IF SCORE<50 THEN ? TAB(23,1);TAB(-1,10);CHR(7); &
"YOU MUST KEEP AT LEAST 50 POINTS ON EACH ROLL "; : &
XCALL ACCEPT,ENTRY : SCORE=SCORE+MINUS : GOTO PICK'UP
FOR R=1 TO XD
IF DICTL(R)=3 THEN ? TAB(22,R*8+4);" "; : &
DICTL(R)=9
NEXT R
CALL DISP'SCR
RCTL=1
GOTO PICK'UP
DISP'SCR:
? TAB(17,55);" This roll ";SCORE USING "#####";
? TAB(18,55);" This turn ";(SCORE+TOTAL) USING "#####";
? TAB(19,55);"Score if taken ";(SCORE+TOTAL+GT(PLR)) USING "#####";
RETURN
!===========================================================
!
SPIN'DICE:
? TAB(-1,29);TAB(-1,24);
FOR T=1 TO 8-XD
TT=TIME
FOR SPX=SPIN TO XD
SPP=INT(6*RND(0)+1)
IF SPP=1 THEN CALL SD1
IF SPP=2 THEN CALL SD2
IF SPP=3 THEN CALL SD3
IF SPP=4 THEN CALL SD4
IF SPP=5 THEN CALL SD5
IF SPP=6 THEN CALL SD6
NEXT SPX
IF TT=TIME THEN XCALL SLEEP,.1
NEXT T
? TAB(-1,28);TAB(-1,23);
RETURN
SD1:
? TAB(17,8*SPX);" ";
? TAB(18,8*SPX);".-----.";
? TAB(19,8*SPX);"| * * |";
? TAB(20,8*SPX);"`-----'";
? TAB(21,8*SPX);" ";
RETURN
SD2:
? TAB(17,8*SPX);" ";
? TAB(18,8*SPX);" ";
? TAB(19,8*SPX);"[ * * ]";
? TAB(20,8*SPX);" ";
? TAB(21,8*SPX);" ";
RETURN
SD3:
? TAB(17,8*SPX);".-----.";
? TAB(18,8*SPX);"| * * |";
? TAB(19,8*SPX);"| * * |";
? TAB(20,8*SPX);"| * * |";
? TAB(21,8*SPX);"`-----'";
RETURN
SD4:
? TAB(17,8*SPX);" / \ ";
? TAB(18,8*SPX);" / \ ";
? TAB(19,8*SPX);"< * >";
? TAB(20,8*SPX);" \ / ";
? TAB(21,8*SPX);" \ / ";
RETURN
SD5:
? TAB(17,8*SPX);".-----.";
? TAB(18,8*SPX);"| * |";
? TAB(19,8*SPX);"| * |";
? TAB(20,8*SPX);"| * |";
? TAB(21,8*SPX);"`-----'";
RETURN
SD6:
? TAB(17,8*SPX);" .---.";
? TAB(18,8*SPX);" | * | ";
? TAB(19,8*SPX);"| * | ";
? TAB(20,8*SPX);" | * | ";
? TAB(21,8*SPX);" `---'";
RETURN
!===========================================================
!
CLEAR'DICE:
? TAB(-1,29);
FOR I=1 TO 5
? TAB(16+I,8);SPACE(41);
NEXT I
? TAB(-1,28);
RETURN
!===========================================================
!
CLEAR'COL:
FOR I=1 TO 10
? TAB(I+2,PLR*13-9);" "
NEXT I
PLRROW(PLR)=0
RETURN
!===========================================================
!
OVER'FIVE:
CALL CLEAR'DICE
LAST=PLR
? TAB(22,1);TAB(-1,10);TAB(23,1);CHR(7);
? PLNAM(LAST);" is now over 5000. All other player have one more chance"
XCALL ACCEPT,ENTRY
WIN'SCR=GT(LAST)
RETURN
!============================================================
!
NEW'WINR:
! CALL CLEAR'DICE
? TAB(22,1);TAB(-1,10);TAB(23,1);CHR(7);
? "You have beat the winner. New high score is ";WIN'SCR;
WIN'SCR=SCORE+TOTAL+GT(PLR)
LAST=PLR
RETURN
!============================================================
!
DONE:
DELAY=3
CALL DELAY
! CALL CLEAR'DICE
WINR=1
FOR I=2 TO NOP
IF GT(I)>GT(I-1) THEN WINR=I
NEXT I
? TAB(22,1);TAB(-1,10);TAB(23,1);CHR(7);TAB(-1,14);
? "The winner is ";PLNAM(WINR);" with a score of ";GT(WINR)
END
!===================================================================
!
FIVE:
? TAB(22,1);TAB(-1,10);TAB(23,1);CHR(7);
? "The winner is ";PLNAM(PLR);" with FIVE ";DESC[(DI(1)*6-5);6]
END
!==================================================================
!
THREE:
DICNT=0
TCTL=0
RCTL=3
IF NO1>2 THEN NO1=NO1-3 : SCORE=SCORE+1000 : TCTL=1
IF NO2>2 THEN NO2=NO2-3 : SCORE=SCORE+200 : TCTL=2
IF NO3>2 THEN NO3=NO3-3 : SCORE=SCORE+300 : TCTL=3
IF NO4>2 THEN NO4=NO4-3 : SCORE=SCORE+400 : TCTL=4
IF NO5>2 THEN NO5=NO5-3 : SCORE=SCORE+500 : TCTL=5
IF NO6>2 THEN NO6=NO6-3 : SCORE=SCORE+600 : TCTL=6
FOR R=1 TO XD
IF DI(R)=TCTL THEN DICTL(R)=3 : DICNT=DICNT+1
IF DICNT=3 THEN R=XD
NEXT R
RETURN
!===================================================================
!
STRGHT:
RCTL=5
SCORE=SCORE+1500
IF NO1>0 THEN NO1=NO1-1
NO2=NO2-1 : NO3=NO3-1: NO4=NO4-1 : NO5=NO5-1
IF NO6>0 THEN NO6=NO6-1
NO1=0 : NO5=0
RETURN
!====================================================================
! INSULTING REMARKS
!
TUFF:
? TAB(22,1);TAB(-1,10);
TUFF=INT(20*RND(0)+1)
ON TUFF CALL TF1,TF2,TF3,TF4,TF5,TF6,TF7,TF8,TF9,TF10,TF11,TF12
ON TUFF-12 CALL TF13,TF14,TF15,TF16,TF17,TF18,TF19,TF20
DELAY=3
CALL DELAY
GOTO EUP
TF1: ? " SO SORRY - YOU'RE SO SORRY CAN'T EVEN SCORE";
RETURN
TF2: ? "THAT'S TOO BAD - HOPE YOU'RE STILL AROUND FOR ANOTHER TURN";
RETURN
TF3: ? " YOU'RE NOT GOING TO WIN AT THIS RATE";
RETURN
TF4: ? "GOOD THING THERE'S NO MONEY ON THIS - OR IS THERE?";
RETURN
TF5: ? "MY GRANDMOTHER COULD DO BETTER; AND SHE'S A DEAD ADDING MACHINE!";
RETURN
TF6:
? " MY CPU BLEEDS FOR YOU";
RETURN
TF7:
? " THAT'S THE WAY THE OLD CURSOR BOUNCES";
RETURN
TF8:
? " SOME DAYS ARE LIKE THAT";
RETURN
TF9:
? " OH WOW! LIKE THAT'S REALLY TOO BAD, FOR SURE";
RETURN
TF10:
? " MY DAHLINK, THAT WAS MAAAAHAVELOUS";
RETURN
TF11:
? "
GEE - AND WE WERE ALL COUNTING ON YOU";
RETURN
TF12:
? "IF LUCK WERE BRAINS YOU WOULDN'T WORRY EINSTEIN";
RETURN
TF13:
? " WELL THEY CAN'T ALL BE WINNERS";
RETURN
TF14:
? " I'M AFRAID YOUR LUCK HAS RUN OUT";
RETURN
TF15:
? "WHEN YOU'RE HOT YOU'RE HOT - WHEN YOU'RE NOT YOU'RE NOT";
RETURN
TF16:
? " GOOD THING THIS AIN'T NO CHAMPIONSHIP";
RETURN
TF17:
? " WOW DUDE, THAT'S A WIPE OUT !!!!!!!!!";
RETURN
TF18:
? " YOU SAY YOU LEARNED TO PLAY WHERE ???";
RETURN
TF19:
? " WELL I'LL BE A !@$+%^&()*)@$ ";
RETURN
TF20:
? " WHO YOU GONNA CALL ???";
RETURN
REAL'TUFF:
? TAB(22,1);TAB(-1,10);
? TAB(22,1);CHR(7);
RANDOMIZE
TUFF=INT(5*RND(0)+1)
ON TUFF CALL RTF1,RTF2,RTF3,RTF4,RTF5
DELAY=3
CALL DELAY
GOTO EUP
RTF1: ? "WELL THERE GOES THE WHOLE ENCHILADA ";
RETURN
RTF2: ? "I'M AFRAID YOUR LUCK HAS RUN OUT";
RETURN
RTF3: ? "WHEN YOU'RE HOT YOU'RE HOT - AND YOU'RE FREEZIN'";
RETURN
RTF4: ? "I SURE HOPE YOU DIDN'T BET THE RENT MONEY";
RETURN
RTF5: ? "MY GRANDMUDDA COULDA DONE BETTER & SHE'S A DEAD ADDING MACHINE!";
RETURN
DELAY:
? TAB(-1,7);TAB(-1,29);
TT=TIME
TT=TT+DELAY
DL1:
TTT=TIME
IF TT=>TTT THEN GOTO DL1
? TAB(-1,8);TAB(-1,28);
RETURN
