10 clear screen

documentation            	   ===== FIVE DICE ======	       Alan Steelbat Sept.2012
doc																		revised April 2018
doc
doc  Try to achieve the best sequence possible for the highest score possible
doc       Scoring possibilities are : 
doc                                   7 points - One Pair
doc                                   10       - Three of a Kind
doc	                                  15	   - Four of a Kind
doc	                                  20       - Two Pairs
doc                                   24       - Low Run
doc                                   30       - Pair & Three of a Kind
doc                                   40       - High Run
doc                                   50       - Five of a Kind
doc
doc  To Play -
doc    After the dice are thrown you may hold dice by using buttons 1 to 5
doc    If you do not want to change any of the dice hold all five.
doc    Press RESET to release any held dice.
doc    Use the ROLL button to roll un-held dice.
doc    There are three rolls in a set to achieve a high score.
doc    You have ten sets of rolls in a game.
docu
for a=1 to arraysize(docu$(),1)	:	print docu$(a)	:	next a
	
# -------------------------------------------------------
20 setting_up(o)								//	call initialisation subroutine
30 label Restart								//  play again jumps here
40 clear window
50 t=10	:	l=0
60 ns=0	:	sc=0
70 z1=0	:	z2=0
80 a$=""	:	n$=""	:	sc$=""	
# -------------------------------------------------------
100 label MainLoop
110 for l=1 to 5	:	f(l)=0	:	next l
115 clrtable(o)	 
120 gosub 1000	:	gosub 1200
140 gosub 1000	:	gosub 1200
160 gosub 1000	:	gosub 3000
220 t=t-1	: 	if (t=0) goto 2000
290 goto 100
# -------------------------------------------------------
1000 label Generate_Dice
1010 	for l=1 to 5
1015		if f(l)=1 goto 1060
1020		q=int(ran(1)*60+10)
1023		d(l)=1
1025 		for e=1 to q
1030			xpos=70*l	
1035			d(l)=d(l)+1
1040 			if (d(l)=7) let d(l)=1
1045			for delay=1 to 100	:	next delay
1050			display(o)
1055 		next e
1060 	next l
1099 return
# -------------------------------------------------------
1200 label Stop_Flags
1201 a$= str$ (11-t)	:	text 350,416, "Set No:"		:	text 406,416,a$
1202 clear fill box 0,100,450,130						//	remove  all "held"
1203 text 160,40, "== HOLD NOW =="	
1204 for b=1 to 7
1205	button(b,off)									// place buttons
1206 next b
1209 for l=1 to 5	:	f(l)=0	:	next l
1210 select_button(b)									//    a value returns in a$
1220 if (a$= "r") goto 1260								// ROLL
1225 if (a$= "0") goto 1200								// RESET
1230 a= val (a$)	:	if	(a<1 or a>5) goto 1210 
1244 x=(a*70)-30 	:  	clear fill box x,100,x+70,140	// 	remove digit
1245 f(a)=1	:	text x+15,130, "held"	:	goto 1210
1260 label roll_pressed			// 	jump here
1270 clear fill box 160,24,330,40 	//	remove "== HOLD NOW =="
1280 return
# ------------------------------------------------------
2000 label Game_Over
2010 clear window	:	text 155,60, "Game Over" 
2060 sc$=str$(sc)	:	text 145,100, "Your Score Is"	:	text 195,125,sc$
2080 text 140,400, "play again ?"	
2090  	button(8,off)	:	button(9,off)
2095 	select_button(b)
2100 if a$<> "n" goto Restart
2900 exit
# --------------------------------------------------------
3000 label Score_the_Dice
3001 rem score in ns
3010 for l=1 to 6	:	s(l)=0	:	next l
3020 for l=1 to 5
3030 	s(d(l))=s(d(l))+1
3040 next l
3050 z2=0	:	for l=1 to 6
3060 	if s(l)=1 let z2=z2+1
3070 next l
3100 z1=0	:	for l=1 to 6
3110 	if s(l)=0 let z1=z1+1
3120 next l
3130 if (z1=5) let i=1	:	goto 3500
3140 if (z1=1 and s(6)=0) let i=4	:	goto 3500
3150 if (z1=1 and s(1)=0) let i=2	:	goto 3500
3155 if (z1=1) let i=9	:	goto 3500
3160 if (z1=2) let i=8	:	goto 3500
3170 if (z1<>3) goto 3200 
3180 if (z2=1) let i=5	:	goto 3500
3190 if (z2=2) let i=7	:	goto 3500
3200 if (z2=1) let i=6	:	goto 3500
3210 let i=3	:	goto 3500
# -------------------------------------------------------
3500 label scoring		//		score now in ns and message in n$
3520 clrtable(o)		//		clear text area
3530 text 140,120,n$(i)
3535 sc$=str$(n(i))
3540 text 165,216, "SCORE:" 	:	text 220,216,sc$
3550 	button(8,off)	:	button(9,off)
3580 sc=sc+n(i)
3600 	select_button(b)
3620 if (a$= "n") exit
3630 
3640 return
# =================================================================================================== #

# -------------------------------------------- Setting Up ------------------------------------------- #
sub setting_up(o)
	open window 100,50 
	def_buttons()
	clear window
	dim	d(5) , f(5) , s(6)	,n(9)		//		n$(20{chars})
	dim dicered$(6) , diceblu$(6)	,n$(9)	:	r=5  
	for n= 1 to 6  
		color 252,0,0	:	fill box 3,3,47,47				//  red block
		color 0,0,252	:	fill box 53,3,97,47				//  blue block
		color 0,0,0	:	box 1,1,49,49	:	box 2,2,48,48	//  black edge (double thick)
		box 51,1,99,49	:	box 52,2,98,48					//  edges of blue block
		dot 3,3 : dot 3,47 : dot 47,3 : dot 47,47			//  champher corners
		dot 53,3 : dot 53,47 : dot 97,3 : dot 97,47
		read d   											// number of spots
		for i=1 to d
			read x,y									 	//  position of spot
			color 252,252,252	:	fill circle x,y,r		//  white spot on red dice
			fill circle 50+x,y,r							//  white spot on blue dice
			color 0,0,0	: circle x,y,r : circle 50+x,y,r	//  rim of spots
		next i
	dicered$(n) = getbit$ (1,1,49,49)						//  store dice in array
	diceblu$(n) = getbit$ (51,1,99,49)
	next n					// 	 The Dice needs odd no.of pixels so odd nums are positioned centrally
	close window	:	backcolor 12,128,0:		open window 451,450	

label scoretable
	for i=1 to 9
		read n(i) , n$(i)
	next i
 
end sub
	
# -------------------------------------------- Display -------------------------------------------- #
sub display(o)
	
	switch 	l								
		
		case 1	:	putbit dicered$(d(1)),50,45, "solid"	:	break
		case 2 	:	putbit diceblu$(d(2)),120,45, "solid"	:	break
		case 3	:	putbit dicered$(d(3)),190,45, "solid"	:	break	
		case 4 	:	putbit diceblu$(d(4)),260,45, "solid"	:	break
		case 5	:	putbit dicered$(d(5)),330,45, "solid"			
	end switch
end sub
# -------------------------------------------------------
sub clrtable(o)
	clear fill box 0,100,450,140
	clear fill box 0,200,450,230
	clear fill box 0,300,450,330
	clear fill box 0,400,450,430
end sub

# ==================================== data for dice =========================================== #
data 1,25,25
data 2,36,14,14,36
data 3,12,12,25,25,38,38
data 4,14,14,14,35,35,14,36,36
data 5,12,12,12,38,25,25,38,12,38,38
data 6,14,12,14,25,14,38,36,12,36,25,36,38
	//			data -1,-1,-1
# =================================== data for scoretable ====================================== #
data 50, "****** EUREKA ******", 40, "***** HIGH RUN *****", 30, "**** FULL HOUSE ****"
data 24, "***** LOW RUN *****", 20, "** DOUBLE DOUBLE **", 15, "**** FOUR TIMES ****"
data 10, "*** THREE TIMES ***", 7, "MADE FOR EACH OTHER", 0, "******* ZERO *******"

		
# ========================================= Subroutines for Buttons================================ #
sub def_buttons()
	off=0	:	lit=9
	dim btn$(9+9)												// scope for up to 9 buttons
	for b=1 to 9												// actual number of buttons = 4
	clear window	: bx=1 : by=1										
	switch b 
		case 1 : txt$=" 1 " 	: break    						// define button text
		case 2 : txt$=" 2 "		: break
		case 3 : txt$=" 3 "		: break
		case 4 : txt$=" 4 "		: break
		case 5 : txt$=" 5 "		: break
		case 6 : txt$="RESET "	: break
		case 7 : txt$=" ROLL "	: break
		case 8 : txt$="next"	: break
		case 9 : txt$="exit"	: break
	end switch	
	xz=bx+(len(txt$)*7)+20+20	:	yz=by+28					// calc button size
	color b,160,160	: fill box bx,by,xz,yz						// dim + color shaded to give separate identity
	color b,0,0 : box bx,by,xz,yz : coltext(b,0,0,bx+20,by+23,txt$)
	btn$(b)= getbit$(bx,by,xz,yz)
	color b,190,190	: fill box bx,by,xz,yz						// lit + color shaded to give separate identity
	color b,0,0 : box bx,by,xz,yz : coltext(b,0,0,bx+20,by+23,txt$)
	btn$(b+9)= getbit$(bx,by,xz,yz)
	next b
end sub
# ============================================================================================================ #
sub select_button(b)
	b=0
Repeat : Repeat
	inkey$	: 	mx= mousex : my= mousey							// mousebutton down
	q$= getbit$(mx,my,mx,my)
	b= val(mid$(q$,10,1))										// extract identity number if any button selected
 Until (b>0)
	button(b,lit)												// overdraw button in lit state
	ob=b  
	inkey$	: 	mx= mousex : my= mousey							// mousebutton up
	q$= getbit$(mx,my,mx,my) 
	b= val(mid$(q$,10,1))									
	if (b<>ob) let b=0											// mousepointer has moved away from selected button 
	button(ob,off)												// overdraw button in off state
Until (b>0)	 
	switch b													// could return just value b or 
		case 1 : a$="1"	: break							// define the buttons functions here.
		case 2 : a$="2"	: break							// 
		case 3 : a$="3"	: break							// done with switch like this allows for 
		case 4 : a$="4"	: break							// other parameters to be included
		case 5 : a$="5" : break
		case 6 : a$="0"	: break
		case 7 : a$="r"	: break
		case 8 : a$="y"	: break
		case 9 : a$="n"	: break
	end switch	
end sub	
# ============================================================================================================ #
sub button(b,clr)	
	switch b 
		case 1 : bx= 45 : by=110 : break    	// set button position 
		case 2 : bx=115 : by=110 : break
		case 3 : bx=185 : by=110 : break
		case 4 : bx=255 : by=110 : break
		case 5 : bx=325	: by=110 : break
		case 6 : bx=165	: by=200 : break				// reset button
		case 7 : bx=165	: by=300 : break				// roll button
		case 8 : bx=140 : by=400 : break				// next
		case 9 : bx=240 : by=400 : break				// exit
	end switch
 
	bc=clr+b	:	putbit btn$(bc),bx,by		// place the button image
end sub

# ============================================================================================================ #
sub coltext(r,g,b,tx,ty,txt$)
	local ys , xe , xc , yc, test$
	test$= "rgb 1,1:000000"											// =one Getbit$ black text pixel 
	text tx,ty,txt$													// print the text - is still black at this stage 
	ys= y-13														// ys = y-axis start position		
	xe= tx+(len(txt$)*13)			  								// xe = x-axis end position
	color r,g,b
	for xc= tx to xe
		for yc=  ys to ty
			grab$=  getbit$(xc,yc,xc,yc)							// grab a single pixel from text field
			if (grab$=test$) then									// test if black text color
				dot xc,yc											// overwrite text with new color
			endif
		next yc
	next xc
end sub
# ============================== End Of Program Statements ===================================== #