'Keno example program for Emergence BASIC
'Green = selected, yellow = miss, red = hit
'the balls are represented in an integer array
'values for the array are:
'0 = not selected, 1 = selected, 2 = hit, 3 = miss

'Compile as a WINDOWS target

Autodefine "off"

WINDOW playwin
INT h,x,y,num,selectcount,picked,hitcount,playing,done
INT balls[80],pay[10,10],bet=1,credits=100
UINT colorball,cacheDC
ISTRING strball[64],strstat[64]

DECLARE selectball(mx:int,my:int)

'The ball colours
UINT selected = RGB(0,255,0)
UINT hit = RGB(255,0,0)
UINT miss = RGB(255,255,0)

'load the paytable
for x=0 to 9
	for y=0 to 9
		getdata paytable,h
		pay[x,y] = h
	next y
next x

'the play window
OPENWINDOW playwin,0,0,540,400,@NOAUTODRAW|@MINBOX,0,"Keno",&playhandler
	SETWINDOWCOLOR playwin,RGB(0,0,255)
	CONTROL playwin,@BUTTON,"START",5,340,70,20,0x50000000,1
	CONTROL playwin,@BUTTON,"CLEAR",80,340,70,20,0x50000000,2
	CONTROL playwin,@BUTTON,"Up",250,340,30,20,0x50000000,3
	CONTROL playwin,@BUTTON,"Dn",311,340,30,20,0x50000000,4
	CONTROL playwin,@EDIT,"1",280,340,30,20,0x50000000|@CTEDITRO,5
	control playwin,@BUTTON,"+1",410,340,30,20,0x50000000,6
	control playwin,@BUTTON,"+5",440,340,30,20,0x50000000,7
	control playwin,@BUTTON,"+20",470,340,30,20,0x50000000,8
	control playwin,@BUTTON,"+50",500,340,30,20,0x50000000,9

'normal stuff
playing = 0

WAITUNTIL IsWindowClosed(playwin)
	END

'The playwin window procedure subroutine
'Center the window on creation
'Process the left mouse button to select/unselect balls
'Process the timer to pick random balls
'Start and clear the board in response to our two buttons
SUB playhandler(),INT
	SELECT @MESSAGE
CASE @IDCLOSEWINDOW
		CLOSEWINDOW playwin
CASE @IDCREATE
		CENTERWINDOW playwin
CASE @IDPAINT
		drawballs()
CASE @IDLBUTTONDN
		selectball(@MOUSEX,@MOUSEY)
CASE @IDCONTROL
	IF @NOTIFYCODE = 0
	SELECT @CONTROLID
CASE 1
	if credits < bet
	MessageBox playwin,"Not enough credits to play","Keno"
	else
	startplay()
	endif
CASE 2
	clearboard()
CASE 3 'bet up
	bet+=1
	if bet > 10 then bet = 10
	SetControlText playwin,5,LTRIM$(STR$(bet))
	drawballs()
CASE 4 'bet down
	bet-=1
	if bet < 1 then bet = 1
	SetControlText playwin,5,LTRIM$(STR$(bet))
	drawballs()
case 6
	credits+=1
	drawballs()
case 7
	credits+=5
	drawballs()
case 8
	credits+=20
	drawballs()
case 9
	credits+=50
	drawballs()
ENDSELECT
ENDIF
CASE @IDCHAR
	SELECT @CODE
CASE ASC("s")
CASE& ASC("S")
	startplay()
CASE ASC("c")
CASE& ASC("C")
	clearboard()
ENDSELECT
CASE @IDTIMER
	if picked < 20
	pickball()
	picked++
	drawballs()
	else
	endplay()
	playing = 0
	endif
ENDSELECT
RETURN 0
ENDSUB

'------------------- DRAWBALLS ---------------
'Draw 80 balls and the status text
'Balls are coloured depending on the value of the balls' array
'0 = not selected, 1 = selected, 2 = hit, 3 = miss
'---------------------------------------------
SUB drawballs()
int width,height
	SETFONT playwin,"Arial",12,400
	DRAWMODE playwin,@TRANSPARENT
	FRONTPEN playwin,RGB(0,0,0)
	cacheDC = GetHDC(playwin)
	num = 1
	for y = 0 to 7
		for x = 0 to 9
			colorball = 0xFFFFFF
			if balls[num-1] = 1 THEN colorball = selected
			if balls[num-1] = 2 THEN colorball = hit
			if balls[num-1] = 3 THEN colorball = miss
			CIRCLE playwin,(x*40)+20,(y*40)+20,20,0,colorball
			MOVE playwin,(x*40) + 10, (y*40) + 10
			strball = ltrim$(str$(num))
			if num < 10 THEN strball = "0" + strball
			PRINT playwin,strball
			num++
		next x
	next y
	ReleaseHDC playwin,cacheDC
	SETFONT playwin,"Lucida Console",10,800
	cacheDC = GetHDC(playwin)
	RECT playwin,407,5,120,310,RGB(255,255,0),RGB(0,0,255)
	DRAWMODE playwin,@TRANSPARENT
	FRONTPEN playwin,RGB(255,255,255)
	BACKPEN playwin,RGB(0,0,255)
	for x = 1 to selectcount
		if(hitcount = x)
			RECT playwin,408,x*26-14,118,26,RGB(0,255,0),RGB(0,255,0)
			move playwin,410,x*26-10
			print playwin,using("##   ######",x,pay[x-1,selectcount-1]*bet)
		else
			move playwin,410,x*26-10
			print playwin,using("##   ######",x,pay[x-1,selectcount-1]*bet)
		endif
	next x
	ReleaseHDC playwin,cacheDC

	DRAWMODE playwin,@OPAQUE
	SETFONT playwin,"MS Sans Serif",10,400
	cacheDC = GetHDC(playwin)
	GETTEXTSIZE playwin,"Hits",width,height
	move playwin,407+60-width/2,0
	print playwin,"Hits"
	
	MOVE playwin,155,342
	strstat = "Drawn: " + ltrim$(str$(picked))
	PRINT playwin,strstat,"  "
	MOVE playwin,420,322
	PRINT "CREDITS: ",ltrim$(str$(credits)),"    "
	MOVE playwin,282,322
	PRINT "BET"
	ReleaseHDC playwin,cacheDC
ENDSUB

'------------------- SELECTBALL ---------------
'The mouse co-ordinates are converted to a ball number
'Balls can be deselected by clicking a second time
'Only a maximum of 10 balls can be selected in standard keno
'----------------------------------------------
SUB selectball(mx:int,my:int)
	IF playing THEN RETURN
	x = (mx - 10) / 40.0
	y = (my - 10) / 40.0
	num = x + (y * 10)
	if (num > 79) | (num < 0) THEN RETURN
	SELECT balls[num]
		CASE 3
		CASE& 0
			IF selectcount < 10
				balls[num] = 1
				selectcount++
			ENDIF
		CASE 1
		CASE& 2
			balls[num] = 0
			selectcount--
	ENDSELECT
	drawballs()
ENDSUB

'---------------- STARTPLAY -----------------
'The previous draws are cleared and a timer is started
'One ball will be randomly picked every time the timer expires
'The two buttons are disabled until play completes
'--------------------------------------------
SUB startplay()
	IF selectcount > 0
		credits -= bet
		playing = 1
		picked = 0
		hitcount = 0
		FOR x = 0 to 79
			IF balls[x]=3 THEN balls[x] = 0
			IF balls[x]=2 THEN balls[x] = 1
		NEXT x
		drawballs()
		for x=1 to 9
			ENABLECONTROL playwin,x,0
		next x
		STARTTIMER playwin,100
	ENDIF
ENDSUB

'----------------- ENDPLAY ------------------
'After 20 balls are generated the timer is stopped
'The two buttons are re-enabled
'--------------------------------------------
SUB endplay()
	STOPTIMER playwin
	for x=1 to 9
		ENABLECONTROL playwin,x,1
	next x
	credits += pay[hitcount-1,selectcount-1]*bet
	DrawBalls()
ENDSUB

'---------------- CLEARBOARD ----------------
'Clears all the selected balls and resets the counters
'--------------------------------------------
SUB clearboard()
	FOR x = 0 TO 79
		balls[x] = 0
	NEXT x
	selectcount = 0
	picked = 0
	hitcount = 0
	drawballs()
ENDSUB

'---------------- PICKBALL -----------------
'Generates a random number between 0 and 79
'if the number has already been drawn then continues generating
'a random number until a non-drawn ball is found
'-------------------------------------------
SUB pickball()
	done = 0
DO
	x = int(rnd(80))
	if (balls[x] <> 3) & (balls[x] <> 2) THEN done = 1
UNTIL done
'If it's a selected ball then set it to 'hit'
	IF balls[x] = 1
		balls[x] = 2
		hitcount++
	ENDIF
'If it's a non-selected ball then set it to 'miss'
	IF balls[x] = 0 THEN balls[x] = 3
ENDSUB

'balls picked
'    1,2,3,4,5,6,7,8,9,10
databegin paytable
data 3,0,0,0,0,0,0,0,0,0 'match 1
data 0,15,2,2,0,0,0,0,0,0 'match 2
data 0,0,46,5,3,3,1,0,0,0 'match 3
data 0,0,0,91,12,4,2,2,1,0 'match 4
data 0,0,0,0,810,70,26,12,6,5 'match 5
data 0,0,0,0,0,1600,400,98,44,24 'match 6
data 0,0,0,0,0,0,7000,1652,335,142 'match 7
data 0,0,0,0,0,0,0,10000,4700,1000 'match 8
data 0,0,0,0,0,0,0,0,10000,4700 'match 9
data 0,0,0,0,0,0,0,0,0,20000 'match 10
dataend

/*                                       TABLE 1
                               NUMBER OF SPOTS SELECTED
     HITS     1     2   3     4     5       6     7         8       9      10
       1      3     0   0     0     0       0     0         0       0       0
       2     --    15   2     2     0       0     0         0       0       0
       3     --    --  46     5     3       3     1         0       0       0
       4     --    --  --    91    12       4     2         2       1       0
       5     --    --  --    --   810      70    26        12       6       5
       6     --    --  --    --    --    1600   400        98      44      24
       7     --    --  --    --    --      --  7000      1652     335     142
       8     --    --  --    --    --      --    --     10000    4700    1000
       9     --    --  --    --    --      --    --        --   10000    4700
      10     --    --  --    --    --      --    --        --      --   20000
*/