!
! 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


200 MAP1 DESC,S,36," ONES  TWOS THREESFOURS FIVES SIXES "

	XX(1)="    *    "  !     ,-----,
	XX(2)="*       *"  !     | * * |
	XX(3)="*   *   *"  !     | * * |
	XX(4)="* *   * *"  !     | * * | 
	XX(5)="* * * * *"  !     `-----'
	XX(6)="* ** ** *"

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

!============================================================
!
DEFAULTS:
	NOD=5
	W=5
	MSOB=500
	MS=50

!============================================================
!
INSTRUC:
	? TAB(3,1);TAB(-1,10);

	? 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

	NEXT T
	? TAB(-1,28);TAB(-1,23);TAB(-3,DBCLR);
	RETURN
SDDLY:
!	IF TINDX+SPIN'DRG<TIME THEN RETURN
	SPDG=1/SPIN'DRG
	FOR TID=1 TO 10 STEP SPDG
	NEXT TID
	RETURN
SD1:
	? TAB(-3,0);
	? TAB(17,8*SPX);"       ";	
	? TAB(-3,DBCLR);
	? TAB(18,8*SPX);".-----.";	
	? TAB(19,8*SPX);"| * * |";	
	? TAB(20,8*SPX);"`-----'";	
	? TAB(-3,0);
	? TAB(21,8*SPX);"       ";	
	RETURN
SD2:
	? TAB(-3,0);
	? TAB(17,8*SPX);"       ";	
	? TAB(18,8*SPX);"       ";	
	? TAB(-3,DBCLR);
	? TAB(19,8*SPX);"[ * * ]";	
	? TAB(-3,0);
	? 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
SD7:
	? 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'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'SCR:
	? TAB(17,55);SPACE(25);
	? TAB(18,55);SPACE(25);
	? TAB(19,55);SPACE(25);
	? TAB(21,50);SPACE(30);
	? TAB(23,1);SPACE(80);
	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

!===================================================================
!
BART'SAYS:
	SLP=.3
	OFY=5
	OFX=25
	B=1

        ? 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