!
! D5000U - UPDATE rename to
! D5000C - COLOR VERSION OF D5000
!
!*************************** AMUS Program Label ******************************
! Filename: D5000C.RUN Date: 12/06/93
! Category: GAME Hash Code: 615-507-304-012 Version: 3.0(110)
! Initials: low/AM Name: David Krecklow
! Company: Compu-Center Co., Inc. Telephone #: 8053251004
! Related Files: D5000U.BAS, D5000U.HLP, D5000.CMD, D5000.INT
! Min. Op. Sys.: ANY Expertise Level: BEG
! Special: N
! Description: Uses ACCEPT.SBR, NOECHO.SBR, SLEEP.SBR & TRMCHR.SBR
! A Dice Game (see D5000U.HLP for explination)
!
!*****************************************************************************
PROGRAM D5000C,3.0(110)
SIGNIFICANCE 11
! ***********************************************************************
! * *
! * ******** **** **** **** * *
! * * **** * * * * * * * *
! * ** ** * * * * * * * *
! * ** * * * * * * *
! * ****** **** **** **** * *
! * *
! ***********************************************************************
!
! A COMPUTER DICE GAME by David Krecklow 01/01/1984
! 805/325-1004
! D5000C - COLOR VERSION 07/15/1990
! cleaned up 08/01/1991
!
! This game may not be copied or reproduced in any
! manner for sale without permission of the author.
!
! Donated to AMUS 08/16/91
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,3
MAP2 CHAR,B,1
MAP1 INT'DATA
MAP2 SPIN'FLG,F,6,1 ! spin flag 1 = true
MAP2 SPIN'DRG,F,6,.1 ! spin drag used for xcall sleep time
MAP2 MDLAY,F,6,3 ! message delay time
MAP2 WFCLR,F,6,5 ! writing fore & back colors
MAP2 WBCLR,F,6,0
MAP2 DFCLR,F,6,1 ! dice fore & back colors
MAP2 DBCLR,F,6,4
MAP2 GFCLR,F,6,9 ! grid fore & back colors
MAP2 GBCLR,F,6,10
MAP2 SFCLR,F,6,0 ! score fore & back colors
MAP2 SBCLR,F,6,9
MAP2 IFCLR,F,6,1 ! insult fore & back colors
MAP2 IBCLR,F,6,2
MAP2 MFCLR,F,6,0 ! message fore & back colors
MAP2 MBCLR,F,6,3
MAP2 NFCLR,F,6,1 ! name fore & back colors
MAP2 NBCLR,F,6,4
MAP2 ILINE,S,30 ! ini file input line
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
!
!VARIABLES FOR TRMCHR.SBR
!
!
MAP1 XTC'MAP
MAP2 XTC'FLG,F ! flags
MAP2 XTC'ROWS,F ! number of rows
MAP2 XTC'COLS,F ! number of columns
MAP2 XTC'CLR,F ! number of colors supported
MAP2 XTC'FORE,F ! current foreground color
MAP2 XTC'BACK,F ! current background color
MAP2 XTC'WROW,F ! rows in current window
MAP2 XTC'WCOL,F ! columns in current window
ON ERROR GOTO ER'TRAP
XCALL NOECHO
XCALL TRMCHR,XTC'STAT,XTC'MAP
!============================================================
!
START:
? TAB(-1,14);TAB(-1,0);TAB(1,5);
? TAB(-2,1)TAB(-3,4);" 5 0 0 0 - A COMPUTER DICE GAME"; &
" by David Krecklow "
CALL CHECK'INI
? TAB(-2,7);TAB(-3,0);
CALL BART'SAYS
START1:
? 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 START1
!===============================================
!
NAMES:
? TAB(-2,1);
? TAB(3,1);TAB(-1,10);"Now enter the names of each Player "
NMCTL=0
FOR I= 1 TO NOP
NAM0:
IF I>NOP THEN GOTO NMCNG
FCLR=1+I
BCLR=0
IF FCLR=2 OR FCLR=4 OR FCLR=6 THEN BCLR=1
? TAB(-2,FCLR);TAB(-3,BCLR);
? TAB(I+4,9);" 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
PLNAM(I)=PLNAM(I)+SPACE(10)
ON NMCTL GOTO NMCNG
NEXT I
NMCNG:
? TAB(-2,1);TAB(-3,0);
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
? TAB(-2,7)
? "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 no dice on a roll score your turn is over and you lose your"
? " points for that turn"
? TAB(-2,6)
? "If you score you may pick up the non-scoring dice and keep rolling"
? " or stop and 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"
? TAB(-2,5)
? "Scores requiring more than one di must all be in one roll"
? "You may not combine dice from seperate rolls into scoring combinations"
? " 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 not included in other combinations score 50"
?
? TAB(-2,1);
? "Any key to continue >";
XCALL ACCEPT,ENTRY
?
? TAB(-2,6)
? "You must score ";MSOB;" to get on the board the first time "
? "Enter the numbers of the dice to pick up after your roll"
? " Non-scoring dice will be picked-up automatically"
? "Enter a 'S' or '.' 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"
? TAB(-2,3);
? "5000 wins the game - each player gets one more turn to top the winner"
? " If another player tops the winner the game continues until"
? " all other players including the original winner get one more turn"
?
? TAB(-2,1);
? "PRESS RETURN to start the game >";
XCALL ACCEPT,ENTRY
!============================================================
!
SCREEN:
? TAB(-1,14);TAB(-1,0)
? TAB(-1,23);TAB(-2,GFCLR);TAB(-3,GBCLR);
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); &
TAB(-2,NFCLR)TAB(-3,NBCLR);PLNAM(T); &
TAB(-2,GFCLR);TAB(-3,GBCLR); &
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);TAB(-2,WFCLR);TAB(-3,WBCLR);
!============================================================
!
! MAIN LOOP FOR PLAY
!
UP:
FOR PLR=1 TO NOP
IF LAST=PLR THEN PLR=10 : GOTO EUP
CALL CLEAR'DICE : CALL CLEAR'SCR
? TAB(16,1);TAB(-1,10);SPACE(80);TAB(16,1); &
TAB(PLR*12-8+PLR-2); &
TAB(-2,1);TAB(-3,2);" UP ^ "; &
TAB(-2,WFCLR);TAB(-3,WBCLR);
RCTL=0
? TAB(17,1);TAB(-1,9);"RETURN to roll.....";
XCALL ACCEPT,ENTRY
IF UCS(CHR(ENTRY))="M" CALL MENU
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);TAB(-1,7);
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 : CALL CLEAR'SCR
? TAB(-1,23);TAB(-1,29);
? TAB(-2,DFCLR);TAB(-3,DBCLR);
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);TAB(-2,WFCLR);TAB(-3,WBCLR);
? TAB(-1,8);
!=================================================================
! 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(-2,MFCLR);TAB(-3,MBCLR); &
TAB(21,51);SPACE(27);TAB(-1,22); &
TAB(21,50);TAB(-1,21); &
" ALL DICE MAY ROLL AGAIN ";TAB(-1,22); &
TAB(-2,WFCLR);TAB(-3,WBCLR);
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' or '.' to stop ";
XCALL ACCEPT,ENTRY : RL=ENTRY
IF RL=27 THEN GOTO SCORE
IF RL<>13 AND RL<>83 AND RL<>115 AND RL<>46 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 AND RL<>46 THEN GOTO NXT'ROLL
!============================================================
!
END'ROLL:
IF RCTL<>0 THEN IF (TOTAL+GT(PLR))<MSOB THEN ? TAB(23,1);TAB(-1,9); &
TAB(-2,MFCLR);TAB(-3,MBCLR); &
CHR(7);"You are below the minimum score. You must score "; &
MSOB;" or higher to stop ";TAB(-2,WFCLR);TAB(-3,WBCLR); : &
XCALL ACCEPT,ENTRY : GOTO NXT'ROLL
NO1=0 : NO2=0 : NO3=0 : NO4=0 : NO5=0 : NO6=0
? TAB(-2,SFCLR);TAB(-3,SBCLR);
IF RCTL<>0 THEN GT(PLR)=GT(PLR)+TOTAL
IF RCTL<>0 THEN IF PLRROW(PLR)>9 THEN CALL CLEAR'COL : &
PLRROW(PLR)=1 : &
? TAB(PLRROW(PLR)+2,PLR*13-9); &
(GT(PLR)-TOTAL) USING "######";" *";
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 "######";
? TAB(-2,WFCLR);TAB(-3,WBCLR);
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 ? TAB(24,1);SPACE(50); : &
RETURN
X$=CHR(PK) : PK=VAL(X$)
IF X$="0" THEN RETURN
IF PK<1 OR PK>5 THEN GOTO PICK'UP
IF PK>XD THEN ? TAB(-2,MFCLR);TAB(-3,MBCLR); &
TAB(24,1);CHR(7);" 1 to ";XD;" "; &
TAB(-2,WFCLR);TAB(-3,WBCLR); : &
XCALL ACCEPT,ENTRY : &
PK=ENTRY : GOTO PICK'UP
IF DICTL(PK)=9 THEN ? TAB(-2,MFCLR);TAB(-3,MBCLR); &
TAB(24,1);CHR(7);" YOU HAVE PICKED UP THAT "; &
"ONE BEFORE ";TAB(-2,WFCLR);TAB(-3,WBCLR); : &
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
CALL CLEAR'DICE1
GOTO PICK'UP
PICK'UP'ONE:
SCORE=SCORE-100
IF SCORE<50 THEN GOTO PICK'UP'ERR
NO1=NO1-1
DICTL(PK)=9
CALL CLEAR'DICE1
CALL DISP'SCR
GOTO PICK'UP
PICK'UP'FIVE:
SCORE=SCORE-50
IF SCORE<50 THEN GOTO PICK'UP'ERR
NO5=NO5-1
DICTL(PK)=9
CALL CLEAR'DICE1
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 GOTO PICK'UP'ERR
FOR R=1 TO XD
IF DICTL(R)=3 THEN PK=R : CALL CLEAR'DICE1 : &
DICTL(R)=9
NEXT R
CALL DISP'SCR
RCTL=1
GOTO PICK'UP
PICK'UP'ERR:
? 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
!============================================================
!
DISP'SCR:
? TAB(-2,SFCLR);TAB(-3,SBCLR);
? TAB(17,55);" This roll ";
? TAB(-2,2);TAB(-3,1);SCORE USING "#####";" ";
? TAB(-2,SFCLR);TAB(-3,SBCLR);
? TAB(18,55);" This turn ";
? TAB(-2,1);TAB(-3,2);(SCORE+TOTAL) USING "#####";" ";
? TAB(-2,SFCLR);TAB(-3,SBCLR);
? TAB(19,55);" Score if taken ";
? TAB(-2,1);TAB(-3,4);(SCORE+TOTAL+GT(PLR)) USING "#####";" ";
? TAB(-2,WFCLR);TAB(-3,WBCLR);
RETURN
!===========================================================
!
SPIN'DICE:
IF SPIN'FLG=0 THEN RETURN
? TAB(-1,29);TAB(-1,24);
FOR T=1 TO 8-XD
TINDX=TIME ! index for delay
FOR SPX=SPIN TO XD
SPP=INT(7*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
IF SPP=7 THEN CALL SD7
NEXT SPX
! IF TINDX=TIME THEN IF SPIN'DRG<>0 THEN &
! XCALL SLEEP,SPIN'DRG ! delay if needed
IF SPIN'DRG<>0 THEN CALL SDDLY
!===========================================================
!
CLEAR'DICE:
? TAB(-1,29);
FOR I=1 TO 5
? TAB(16+I,8);SPACE(41);
NEXT I
? TAB(-1,28);
RETURN
CLEAR'DICE1:
! ? TAB(22,PK*8+4);" ";
? TAB(-1,29);
FOR I=1 TO 5
? TAB(16+I,PK*8);SPACE(8);
NEXT I
? TAB(-1,28);
RETURN
!===========================================================
!
CLEAR'COL:
? TAB(-2,GFCLR);TAB(-3,GBCLR);
FOR I=1 TO 10
? TAB(I+2,PLR*13-9);" ";
NEXT I
? TAB(-2,SFCLR);TAB(-3,SBCLR);
PLRROW(PLR)=0
RETURN
!===========================================================
!
OVER'FIVE:
CALL CLEAR'DICE : CALL CLEAR'SCR
LAST=PLR
? TAB(22,1);TAB(-1,10);TAB(23,1);CHR(7);TAB(-2,MFCLR);TAB(-3,MBCLR);
? " ";PLNAM(LAST);" is now over 5000. "; &
"All other player have one more chance "
? TAB(-2,WFCLR);TAB(-3,WBCLR);
IF NOP>1 THEN XCALL ACCEPT,ENTRY
WIN'SCR=GT(LAST)
? TAB(23,1);SPACE(80);
RETURN
!============================================================
!
NEW'WINR:
? TAB(22,1);TAB(-1,10);TAB(23,1);CHR(7);TAB(-2,MFCLR);TAB(-3,MBCLR);
? " You have beat the winner. New high score is ";WIN'SCR;" ";
? TAB(-2,WFCLR);TAB(-3,WBCLR);
WIN'SCR=SCORE+TOTAL+GT(PLR)
LAST=PLR
RETURN
!============================================================
!
DONE:
DELAY=MDLAY
! CALL DELAY
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); &
TAB(-2,MFCLR);TAB(-3,MBCLR);
? " The winner is ";PLNAM(WINR);" with a score of ";GT(WINR);" "
? TAB(-2,XTC'FORE);TAB(-3,XTC'BACK);
IF NOP>1 THEN END
? TAB(24,1);"Of course you were the only player. Try some competition next time!";
END
!===================================================================
!
FIVE:
? TAB(22,1);TAB(-1,10);TAB(23,1);CHR(7);TAB(-2,MFCLR);TAB(-3,MBCLR);
? " The winner is ";PLNAM(PLR); &
" with FIVE ";DESC[(DI(1)*6-5);6];" "
? TAB(-2,XTC'FORE);TAB(-3,XTC'BACK);
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
? TAB(-2,IFCLR);TAB(-3,IBCLR); &
TAB(23,11);SPACE(30);TAB(-1,22); &
TAB(23,10);TAB(-1,21); &
" WOW YOU ROLLED A STRAIGHT ";TAB(-1,22); &
TAB(-2,WFCLR);TAB(-3,WBCLR);
DELAY=MDLAY
CALL DELAY
RETURN
!====================================================================
! INSULTING REMARKS
!
TUFF:
? TAB(23,1);TAB(-1,10);TAB(-2,IFCLR);TAB(-3,IBCLR);
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=MDLAY
CALL DELAY
? TAB(-2,WFCLR);TAB(-3,WBCLR);TAB(23,1);SPACE(80);
GOTO EUP
TF1: ? " SO SORRY - YOU 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 YOU'RE 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(23,1);TAB(-1,10);TAB(-2,IFCLR);TAB(-3,IBCLR);
? TAB(23,1);CHR(7);
RANDOMIZE
TUFF=INT(5*RND(0)+1)
ON TUFF CALL RTF1,RTF2,RTF3,RTF4,RTF5
DELAY=MDLAY
CALL DELAY
? TAB(-2,WFCLR);TAB(-3,WBCLR);TAB(23,1);SPACE(80);
GOTO EUP
RTF1: ? " WELL THERE GOES THE WHOLE ENCHILADA ";
RETURN
RTF2: ? " I'M AFRAID YOU'RE 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
!===================================================================
!
CHECK'INI:
LOOKUP "D5000.INI",F'STAT
IF F'STAT=0 THEN RETURN
OPEN #1,"D5000.INT",INPUT
NXT'INI:
INPUT LINE #1,ILINE
IF EOF(1)<>0 THEN GOTO DONE'INI
IF ILINE[1,2]=":T" THEN INI'DSP=1 : &
? TAB(5,1);TAB(-2,2);TAB(-3,0); : GOTO NXT'INI
IF INI'DSP=1 THEN ? ILINE
INIX=INSTR(1,ILINE,"=")
IF INIX=0 THEN GOTO NXT'INI
ILINE=UCS(ILINE)
IKEY$=ILINE[1,INIX-1]
IVAL$=ILINE[INIX+1,LEN(ILINE)]
IVAL=VAL(IVAL$)
IF IKEY$[1,4] ="WRIT" THEN GOTO INI'WRIT
IF IKEY$[1,4] ="GRID" THEN GOTO INI'GRID
IF IKEY$[1,4] ="DICE" THEN GOTO INI'DICE
IF IKEY$[1,4] ="MESS" THEN GOTO INI'MESS
IF IKEY$[1,4] ="CUTE" THEN GOTO INI'CUTE
IF IKEY$[1,4] ="NAME" THEN GOTO INI'NAME
IF IKEY$[1,4] ="SCOR" THEN GOTO INI'SCOR
IF IKEY$[1,4] ="ROLL" THEN GOTO INI'ROLL
IF IKEY$[1,4] ="DLAY" THEN GOTO INI'DLAY
GOTO NXT'INI
DONE'INI:
CLOSE #1
! IF INI'DSP=1 THEN XCALL SLEEP,2
RETURN
INI'WRIT:
IF IKEY$[5,8]="FORE" THEN WFCLR=IVAL
IF IKEY$[5,8]="BACK" THEN WBCLR=IVAL
GOTO NXT'INI
INI'GRID:
IF IKEY$[5,8]="FORE" THEN GFCLR=IVAL
IF IKEY$[5,8]="BACK" THEN GBCLR=IVAL
GOTO NXT'INI
INI'DICE:
IF IKEY$[5,8]="FORE" THEN DFCLR=IVAL
IF IKEY$[5,8]="BACK" THEN DBCLR=IVAL
GOTO NXT'INI
INI'MESS:
IF IKEY$[5,8]="FORE" THEN MFCLR=IVAL
IF IKEY$[5,8]="BACK" THEN MBCLR=IVAL
IF IKEY$[5,8]="TIME" THEN MDLAY=IVAL
GOTO NXT'INI
INI'CUTE:
IF IKEY$[5,8]="FORE" THEN IFCLR=IVAL
IF IKEY$[5,8]="BACK" THEN IBCLR=IVAL
GOTO NXT'INI
INI'NAME:
IF IKEY$[5,8]="FORE" THEN NFCLR=IVAL
IF IKEY$[5,8]="BACK" THEN NBCLR=IVAL
GOTO NXT'INI
INI'SCOR:
IF IKEY$[5,8]="FORE" THEN SFCLR=IVAL
IF IKEY$[5,8]="BACK" THEN SBCLR=IVAL
GOTO NXT'INI
INI'ROLL:
IF IKEY$[5,8]="DRAG" THEN SPIN'DRG=IVAL
IF IVAL$[1,1]="T" THEN IVAL=1
IF IKEY$[5,8]="DICE" THEN SPIN'FLG=IVAL
GOTO NXT'INI
INI'DLAY:
DLY'TIM=IVAL
GOTO NXT'INI
!===================================================================
!
MENU:
? TAB(17,1);TAB(-1,10); &
"1-Spin 2-Drag 3-Dice Color 4-Message Color 5-Delay"
? TAB(18,1);"6-Score Color 7-Comment color "
? "Enter number to change ";
XCALL ACCEPT,ENTRY
MNX$=CHR(ENTRY)
MNX=VAL(MNX$)
IF ENTRY=13 THEN RETURN
? TAB(19,40);
IF MNX=1 THEN ? "Present spin is "; : IF SPIN'FLG=1 THEN ? "TRUE" &
ELSE ? "FALSE"
IF MNX=2 THEN ? "Present drag is ";SPIN'DRG
IF MNX=3 THEN ? "Present dice colors are ";DFCLR,DBCLR
IF MNX=4 THEN ? "Present message colors are ";MFCLR,MBCLR
IF MNX=5 THEN ? "Present delay is ";MDLAY
IF MNX=6 THEN ? "Present score colors are ";SFCLR,SBCLR
IF MNX=7 THEN ? "Present comment colors are ";IFCLR,IBCLR
IF MNX=1 THEN XCALL ACCEPT,ENTRY
IF MNX=1 THEN IF SPIN'FLG=0 THEN SPIN'FLG=1 &
ELSE SPIN'FLG=0
IF MNX=1 THEN GOTO MENU
CALL MENU'VALUES
IF MNX=2 THEN SPIN'DRG=MNVAL1
IF MNX=3 THEN DFCLR=MNVAL1 : DBCLR=MNVAL2
IF MNX=4 THEN MFCLR=MNVAL1 : MBCLR=MNVAL2
IF MNX=5 THEN MDLAY=MNVAL1
IF MNX=6 THEN SFCLR=MNVAL1 : SBCLR=MNVAL2
IF MNX=7 THEN IFCLR=MNVAL1 : IBCLR=MNVAL2
GOTO MENU
MENU'VALUES:
IF MNX=2 OR MNX=5 THEN GOTO MNV1
? TAB(20,1);"ENTER foreground color ";
CALL MNV2
MNVAL1=VAL(MNX$)
? TAB(21,1);"ENTER background color ";
CALL MNV2
MNVAL2=VAL(MNX$)
RETURN
MNV1:
? TAB(20,1);"ENTER value ";
CALL MNV2
MNVAL1=VAL(MNX$)
RETURN
MNV2:
MNX$=""
MNV3:
XCALL ACCEPT,ENTRY
IF ENTRY=13 THEN RETURN
IF ENTRY=8 OR ENTRRY=127 THEN GOTO MNV4
MNX$=MNX$+CHR(ENTRY)
GOTO MNV3
MNV4:
GOTO MNV3
!===================================================================
!
ER'TRAP:
IF ERR(0)<>1 THEN ON ERROR GOTO 0
? TAB(-2,XTC'FORE);TAB(-3,XTC'BACK)
!===================================================================
END
? TAB(-2,5);
? TAB(-1,29);
RESTORE
FOR I=1 TO 12
READ ILINE
? TAB(OFY+I,OFX+1);ILINE;
NEXT I
FOR I=1 TO 12
? TAB(OFY+8,OFX+12);"___";
? TAB(OFY+9,OFX+12);"\_,";
? TAB(-2,7)
IF I=1 THEN ? TAB(OFY+6,OFX+20);"WOW! This is a really cool game";
IF I=4 THEN ? TAB(OFY+7,OFX+20);"I think you're gonna like it";
IF I=8 THEN ? TAB(OFY+8,OFX+20);"BUT,if you don't -weeeelll-";
IF I=10 THEN ? TAB(OFY+10,OFX+20);"You can just kiss my shorts Homer!";
? TAB(-2,5)
B=B+1
IF B=5 THEN ? TAB(OFY+6,OFX+12);"-)(-";
XCALL SLEEP,SLP
IF I=8 OR I=9 OR I=11 THEN GOTO BSS1
? TAB(OFY+8,OFX+12);"---";
? TAB(OFY+9,OFX+12);" /";
BSS1:
IF B=5 THEN ? TAB(OFY+6,OFX+12);"O)(O"; : B=1
XCALL SLEEP,SLP
NEXT I
? TAB(OFY+8,OFX+11);"\___";
? TAB(OFY+13,OFX+1);TAB(-1,28);TAB(-2,6);
? "Bart Art concept"
? TAB(OFY+14,OFX+1);
? "Thanks to The New Hacker's Dictionary (MIT Press)";
? TAB(-2,5);
RETURN
BART'DATA:
DATA " "
DATA " "
DATA " |\/\/\/| "
DATA " | | "
DATA " | | "
DATA " | (O)(O) "
DATA " C _) "
DATA " | .---| "
DATA " | / "
DATA " /------\ "
DATA " /--------\ "
DATA " "
!===================================================================
END
