!*! 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 PROGRAM D5000,2.2(000) 100 MAP1 NOP,F !number of players MAP1 NOD,F !number of dice MAP1 W,F !winning score MAP1 MSOB,F !minimum score to get on the board MAP1 MS,F !minimum score MAP1 NM,S,10 MAP1 WORKING'VAR MAP2 X$,S,10 MAP2 X,F MAP2 I,F MAP2 NO1,F MAP2 NO2,F MAP2 NO3,F MAP2 NO4,F MAP2 NO5,F MAP2 NO6,F MAP2 XD,F MAP2 R,F MAP2 CL,F MAP2 DICNT,F MAP2 REAL'TUFF,F MAP2 TUFF,F MAP2 WINR,F MAP2 K,F MAP2 L,F MAP2 T,F MAP2 PLR,F MAP2 LAST,F MAP2 RCTL,F MAP2 TCTL,F MAP2 NMCTL,F MAP2 NOTHING,F MAP2 MINUS,F MAP2 TOTAL,F MAP2 SCORE,F MAP2 WIN'SCR,F MAP2 PK,F MAP2 RL,F MAP2 ENTRY,F,6 MAP2 DELAY,B,2 MAP1 CHAR,B,1 MAP1 ROLL(6) MAP2 DI,F MAP2 DICTL,F MAP2 NO,F MAP2 GT,F MAP2 XX,S,9 MAP2 PLRROW,F MAP2 PLNAM,S,10 200 MAP1 DESC,S,36," ONES TWOS THREESFOURS FIVES SIXES " XX(1)=" * " ! ,-----, XX(2)="* *" ! | * * | XX(3)="* * *" ! | * * | XX(4)="* * * *" ! | * * | XX(5)="* * * * *" ! `-----' XX(6)="* ** ** *" XCALL NOECHO !============================================================ ! 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 !============================================================ ! INSTRUC: ? TAB(3,1);TAB(-1,10); NOD=5 W=5 MSOB=500 MS=50 ? ? "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