'===========================================================================
' Subject: Black Box - An Old Board Game      Date: 18-18-02 (  :  )       
'  Author: Richard D. Clark                   Code: WXBASIC                
'  Origin: rickclark58@yahoo.com            Packet: GAMES.ABC
'===========================================================================
' Blackbox
' Richard D. Clark
' rickclark58@yahoo.com
' Portions of code by:
' (c) 2002 David Cuny
Option Explicit

Randomize

'Menus 
Common wxID_SHOWDISKS = wxID_HIGHEST + 10
Common wxID_EASY = wxID_HIGHEST + 11
Common wxID_MEDIUM = wxID_HIGHEST + 12
Common wxID_HARD = wxID_HIGHEST + 13
Common wxID_PATH = wxID_HIGHEST + 14
'Ray direction.
Common GoUp = wxID_HIGHEST + 20
Common GoDown = wxID_HIGHEST + 21
Common GoLeft = wxID_HIGHEST + 22
Common GoRight = wxID_HIGHEST + 23

'Prog info
Common progName = "Blackbox 1.0",
       bmpX     = 500,
       bmpY     = 484,
       Skill    = wxID_EASY,
       InGame = 1

'Background
Const BlackBrush = wxBrush( wxColor( 0x00, 0x00, 0x00), wxSOLID )
'Cell height and width
Const CellHW = 50
'Board array
Common Board[8,8]
'Board coordinates array
Common BoardCO[8,8]
'Disk array
Common Disks[8,8]
'Fire array
Common Fire[8,8]
'Disk counters.
Common myDisks = 0
Common hdDisks = 0
'Show path
Common ShowPath = 0

' create the frame
Common frame = New wxFrame( Null, -1, progName, wxPoint(10, 10), wxSize(500, 550), wxSIMPLE_BORDER | wxCAPTION | wxSYSTEM_MENU | wxMINIMIZE_BOX)
frame.CreateStatusBar( 1 )
frame.SetStatusText("")
'Menu builder code
Common mBar = new wxMenuBar()
frame.SetMenuBar(mBar)
'Menu builder menu definition
Common mGame= new wxMenu()
mBar.Append(mGame, "&Game")
mGame.Append(wxID_NEW, "&New\tAlt-N","Start a new game")
mGame.Append(wxID_SHOWDISKS, "Show &Disks\tAlt-S","Show disks")
mGame.AppendSeparator()
mGame.Append(wxID_EXIT, "E&xit\tAlt-X","Exit Program")
Common mSettings= new wxMenu()
mBar.Append(mSettings, "&Settings")
mSettings.Append(wxID_EASY, "&Easy","Easy skill setting", 1)
mSettings.Append(wxID_MEDIUM, "&Medium","Medium skill setting", 1)
mSettings.Append(wxID_HARD, "&Hard","Hard skill setting", 1)
mSettings.AppendSeparator()
mSettings.Append(wxID_PATH, "Show &Path","Show ray path", 1)
'Set the skill setting
mSettings.Check( Skill, 1 )

' create pens
Common NewColor = 0
Common BoardPens[25]
Common BoardBrush[25]
BoardPens[0] = wxPenFromColorName( "Red", 3, wxSOLID )
BoardBrush[0] = wxBrushFromColorName( "Red", wxSOLID )
BoardPens[1] = wxPenFromColorName( "Orange", 3, wxSOLID )
BoardBrush[1] = wxBrushFromColorName( "Orange", wxSOLID )
BoardPens[2] = wxPenFromColorName( "Yellow", 3, wxSOLID )
BoardBrush[2] = wxBrushFromColorName( "Yellow", wxSOLID )
BoardPens[3] = wxPenFromColorName( "Green", 3, wxSOLID )
BoardBrush[3] = wxBrushFromColorName( "Green", wxSOLID )
BoardPens[4] = wxPenFromColorName( "Blue", 3, wxSOLID )
BoardBrush[4] = wxBrushFromColorName( "Blue", wxSOLID )
BoardPens[5] = wxPenFromColorName( "Purple", 3, wxSOLID )
BoardBrush[5] = wxBrushFromColorName( "Purple", wxSOLID )
BoardPens[6] = wxPenFromColorName( "Black", 3, wxSOLID )
BoardBrush[6] = wxBrushFromColorName( "Black", wxSOLID )
BoardPens[7] = wxPenFromColorName( "White", 3, wxSOLID )
BoardBrush[7] = wxBrushFromColorName( "White", wxSOLID )
BoardPens[8] = wxPenFromColorName( "Aquamarine", 3, wxSOLID )
BoardBrush[8] = wxBrushFromColorName( "Aquamarine", wxSOLID )
BoardPens[9] = wxPenFromColorName( "Coral", 3, wxSOLID )
BoardBrush[9] = wxBrushFromColorName( "Coral", wxSOLID )
BoardPens[10] = wxPenFromColorName( "Cornflower Blue", 3, wxSOLID )
BoardBrush[10] = wxBrushFromColorName( "Cornflower Blue", wxSOLID )
BoardPens[11] = wxPenFromColorName( "Firebrick", 3, wxSOLID )
BoardBrush[11] = wxBrushFromColorName( "Firebrick", wxSOLID )
BoardPens[12] = wxPenFromColorName( "Maroon", 3, wxSOLID )
BoardBrush[12] = wxBrushFromColorName( "Maroon", wxSOLID )
BoardPens[13] = wxPenFromColorName( "Indian Red", 3, wxSOLID )
BoardBrush[13] = wxBrushFromColorName( "Indian Red", wxSOLID )
BoardPens[14] = wxPenFromColorName( "Khaki", 3, wxSOLID )
BoardBrush[14] = wxBrushFromColorName( "Khaki", wxSOLID )
BoardPens[15] = wxPenFromColorName( "Medium Forest Green", 3, wxSOLID )
BoardBrush[15] = wxBrushFromColorName( "Medium Forest Green", wxSOLID )
BoardPens[16] = wxPenFromColorName( "Medium Orchid", 3, wxSOLID )
BoardBrush[16] = wxBrushFromColorName( "Medium Orchid", wxSOLID )
BoardPens[17] = wxPenFromColorName( "Medium Sea Green", 3, wxSOLID )
BoardBrush[17] = wxBrushFromColorName( "Medium Sea Green", wxSOLID )
BoardPens[18] = wxPenFromColorName( "Medium Violet Red", 3, wxSOLID )
BoardBrush[18] = wxBrushFromColorName( "Medium Violet Red", wxSOLID )
BoardPens[19] = wxPenFromColorName( "Midnight Blue", 3, wxSOLID )
BoardBrush[19] = wxBrushFromColorName( "Midnight Blue", wxSOLID )
BoardPens[20] = wxPenFromColorName( "Navy", 3, wxSOLID )
BoardBrush[20] = wxBrushFromColorName( "Navy", wxSOLID )
BoardPens[21] = wxPenFromColorName( "Sienna", 3, wxSOLID )
BoardBrush[21] = wxBrushFromColorName( "Sienna", wxSOLID )
BoardPens[22] = wxPenFromColorName( "Turquoise", 3, wxSOLID )
BoardBrush[22] = wxBrushFromColorName( "Turquoise", wxSOLID )
BoardPens[23] = wxPenFromColorName( "Wheat", 3, wxSOLID )
BoardBrush[23] = wxBrushFromColorName( "Wheat", wxSOLID )
BoardPens[24] = wxPenFromColorName( "Thistle", 3, wxSOLID )
BoardBrush[24] = wxBrushFromColorName( "Thistle", wxSOLID )

' create a bitmap for double buffering
Common bmp = wxEmptyBitmap( bmpX, bmpY )
' create a store for the graphic
Common bmpDC = wxMemoryDC()
bmpDC.SelectObject( bmp )
bmpDC.SetBackground( BlackBrush )
bmpDC.Clear()

'Split routine for delimited lists
Sub Split(alist[], expression, delimiter)
	Dim tempstr  'Working string
	Dim stritem 'Delimited string
	Dim i       'Instr position
	Dim count = 0  'Array counter
	
	'Clear the passed array.
	Erase alist[]
	expression = RTrim$(expression)
	delimiter = RTrim$(delimiter)
	'See if we have an expression
	If Len(expression) > 0 And Len(delimiter) > 0 Then
		'See if we have a delimiter
		i = Instr(expression, delimiter)
		If i > 0 Then
			'Get a working copy of expression.
			tempstr = expression
		Else
			'Force this var to a string
			tempstr = ""
		End If
		'Get all the items.
		While i > 0
			'Get the array item.
			stritem = Left$(tempstr, i - 1)
			'Add it to the array w/o delimiter
			alist[count] = stritem
			'Clip off item and delimiter
			tempstr = Mid$(tempstr, i + Len(delimiter), Len(tempstr) - Len(delimiter))
			'Look for the next delimiter
			i = Instr(tempstr, delimiter)
			'Inc the array counter
			count += 1
		End While
		'Check to see if we have any items left.
		If Len(tempstr) > 0 Then
			'Add them to array
			alist[count] = tempstr
		End If
	End If
End Sub

'Board Drawing routines.
Sub InitBoard()
	Dim x = 10,
		y = 6
	Dim i, j, cnt = 0
	Dim temp = ""
	'Clear the board
	bmpDC.Clear()
	For i = 1 To 8
		For j = 1 To 8
			If i = 1 OR j = 1 OR i = 8 OR j = 8 Then
				'Create a red pen
				bmpDC.SetPen( BoardPens[0] )
				bmpDC.SetBrush( BoardBrush[7] )
			Else
				'Create a white pen
				bmpDC.SetPen( BoardPens[7] )
				bmpDC.SetBrush( BoardBrush[7] )
			End If
			'Don't draw corners.
			If (i = 1 AND j = 1) OR ( i = 1 AND j = 8) OR (i = 8 AND j = 1) OR (i = 8 AND j = 8) Then
				BoardCO[i,j] = "0,0"
			Else
				'Draw the cell on the form
				bmpDC.DrawRoundedRectangle(x, y, CellHW, CellHW, 5)
				'bmpDC.SetPen( BoardPens[0] )
				'bmpDC.DrawText(i & "," & j, x, y)
				'Save the coordinates.
				BoardCO[i,j] = x & "," & y
			End If
			'Inc the cell
			x = x + CellHW + 10
		Next
		x = 10
		y = y + CellHW + 10
	Next
End Sub

Sub GetCell(x, y, cx, cy)
	Dim coord[]
	Dim i,j
	Dim temp = ""
	Dim tx, ty
	Dim found = 0
	
	cx = 0
	cy = 0
	For i = 1 To 8
		For j = 1 To 8
			'Skip corner cells
			If (i = 1 AND j = 1) OR ( i = 1 AND j = 8) OR (i = 8 AND j = 1) OR (i = 8 AND j = 8) Then
				cx = 0
				cy = 0
			Else
				'Get the cell coordinates
				temp = BoardCO[i,j]
				Split(coord[], temp, ",")
				'See if the passed xy are in cell
				tx = Val(coord[0])
				ty = Val(coord[1])
				'Do the passed x,y fall inside the current cell
				If x >= tx AND x <= tx + CellHW Then
					If y >= ty AND y <= ty + CellHW Then
						'Grab the array index
						cx = i
						cy = j
						found = 1
						Exit For
					End If
				End If
			End If
		Next
		'Did we find a disk?
		If found = 1 Then
			Exit For
		End If
	Next
	'ShowBoard()
End Sub

'Shoot a ray into the grid
Sub FireRay(i, j)
	Dim dir
	Dim done = False
	Dim coord[]
	Dim tx, ty
	Dim temp = ""
	Dim chk
	Dim chkd1, chkd2, chkd3, chkd4
	
	'Set the start direction.
	If i = 1 Then
		dir = GoDown
	ElseIf i = 8 Then
		dir = GoUp
	ElseIf j = 1 Then
		dir = GoRight
	ElseIf j = 8 Then
		dir = GoLeft
	End If
	'Iterate through grid
	While done = False
		'Set indexes based on direction.
		If dir = GoDown Then
			i += 1
		ElseIf dir = GoUp Then
			i -= 1
		ElseIf dir = GoRight Then
			j += 1
		ElseIf dir = GoLeft Then
			j -= 1
		End If
		'Did we hit the border?
		If i = 1 OR i = 8 Then
			Fire[i,j] = 1
		ElseIf j = 1 OR j = 8 Then
			Fire[i,j] = 1
		End If
		'Show the path
		If (ShowPath = 1 Or Fire[i,j] = 1) AND Disks[i,j] = 0 Then
			'Get the coordinates.
			temp = BoardCO[i, j]
			Split(coord[], temp, ",")
			tx = Val(coord[0])
			ty = Val(coord[1])
			'Show the firing.
			bmpDC.SetPen( BoardPens[NewColor] )
			bmpDC.SetBrush( BoardBrush[NewColor] )
			bmpDC.DrawRoundedRectangle(tx+5, ty+5, CellHW-10, CellHW-10, 20)
			'bmpDC.SetPen( BoardPens[0] )
			'bmpDC.DrawText(i & "," & j, tx, ty)
		End If
		'Did we hit a disk.
		If Disks[i,j] = 1 OR Fire[i,j] = 1 Then
			done = True
		End If
		'Set the flags
		chk = True
		'So we don't just spin in place
		chkd1 = False
		chkd2 = False
		chkd3 = False
		chkd4 = False
		While chk = True
			'Check for disk above.
			If dir = GoLeft Or dir = GoRight Then
				If i - 1 > 1 Then
					If Disks[i-1,j] = 1 And chkd1 = False Then
						dir = GoDown
						chkd1 = True
						Continue
					End If
				End If
			End If
			'Check for disk to left.
			If dir = GoDown Or dir = GoUp Then
				If j - 1 > 1 Then
					If Disks[i,j-1] = 1 And chkd2 = False Then
						dir = GoRight
						chkd2 = True
						Continue
					End If
				End If
			End If
			'Check for disk below
			If dir = GoLeft Or dir = GoRight Then
				If i + 1 < 8 Then
					If Disks[i+1,j] = 1 And chkd3 = False Then
						dir = GoUp
						chkd3 = True
						Continue
					End If
				End If
			End If
			'Check for disk to right.
			If dir = GoDown Or dir = GoUp Then
				If j +1 < 8 Then
					If Disks[i,j+1] = 1 And chkd4 = False Then
						dir = GoLeft
						chkd4 = True
						Continue
					End If
				End If
			End If
			chk = False
		End While
		
	End While
End Sub

'The frame event handler.
Sub onEvent( event )
	Dim x, y, type
	Dim cx, cy, tx, ty
	Dim coord[]
	Dim temp = ""
	
	frame.SetStatusText("")
	'Get event info
    x = event.GetX()
    y = event.GetY()
    type = event.GetEventType()
    If InGame = 1 Then
		Select Case type
			Case wxEVT_LEFT_UP
				GetCell(x, y, cx, cy)
				If cx > 0 AND cy > 0 Then
					'Make sure the player clicked the outer edge cells
					If (cx = 1 OR cx = 8) OR (cy = 1 OR cy = 8) Then
						'See if we have already fired a ray from here.
						If Fire[cx, cy] = 0 Then
							'Set the fire flag
							Fire[cx, cy] = 1
							'Fire a ray.
							frame.SetStatusText("Firing ray...")
							'Get the coordinates.
							temp = BoardCO[cx, cy]
							Split(coord[], temp, ",")
							tx = Val(coord[0])
							ty = Val(coord[1])
							'Show the firing.
							bmpDC.SetPen( BoardPens[NewColor] )
							bmpDC.SetBrush( BoardBrush[NewColor] )
							bmpDC.DrawRoundedRectangle(tx+5, ty+5, CellHW-10, CellHW-10, 20)
							'Follow ray into grid
							FireRay(cx, cy)
							'Inc color pointer
							NewColor += 1
							If NewColor = 7 Then
								NewColor = 8
							ElseIf NewColor > 24 Then
								NewColor = 0
							End If
							'Show the board.
							ShowBoard()
						End If
					End If
				End If
			Case wxEVT_RIGHT_UP
				GetCell(x, y, cx, cy)
				If cx > 0 AND cy > 0 Then
					If cx > 1 AND cx < 8 Then
						If cy > 1 AND cy < 8 Then
							'Get the coordinates of cell
							temp = BoardCO[cx,cy]
							Split(coord[], temp, ",")
							tx = Val(coord[0])
							ty = Val(coord[1])
							'Toggle disk marker
							If Board[cx,cy] = 0 Then
								'Make sure all disks haven't ben used.
								If myDisks < hdDisks Then
									'Use red color
									bmpDC.SetPen( BoardPens[0] )
									bmpDC.SetBrush( BoardBrush[7] )
									'Draw a circle in the cell
									bmpDC.DrawRoundedRectangle(tx, ty, CellHW, CellHW, 20)
									ShowBoard()
									myDisks += 1
									Board[cx, cy] = 1
								Else
									frame.SetStatusText("You have used all your disks.")
								End If
							Else
								'Use white color
								bmpDC.SetPen( BoardPens[7] )
								bmpDC.SetBrush( BoardBrush[7] )
								'Draw a circle in the cell
								bmpDC.DrawRoundedRectangle(tx, ty, CellHW, CellHW, 20)
								ShowBoard()
								If myDisks > 0 Then
									myDisks -= 1
								End If
								Board[cx, cy] = 0
							End If
						End If
					End If
				End If
		End Select
	End If
End sub

' attach callbacks
Connect( frame, -1, wxEVT_LEFT_UP, "onEvent" )
Connect( frame, -1, wxEVT_RIGHT_UP, "onEvent" )

Sub ShowBoard()
	Dim dc

    dc = wxClientDC( frame )
    dc.BeginDrawing()
    dc.Blit( 0, 0, bmpX, bmpY, bmpDC, 0, 0 )
    dc.EndDrawing()
End Sub


Sub onPaint( event )
	Dim dc
	
    ' get the DC of the frame
    dc = wxPaintDC( frame )
    dc.BeginDrawing()

    ' blit the bitmap
    dc.Blit( 0, 0, bmpX, bmpY, bmpDC, 0, 0 )

    dc.EndDrawing()
End Sub
Connect( frame, -1, wxEVT_PAINT, "onPaint" )

Sub HideDisks()
	Dim i, j, x, y
	
	hdDisks = 0
	myDisks = 0
	'Clear the disks
	For i = 1 To 8
		For j = 1 To 8
			Disks[i,j] = 0
			Fire[i,j] = 0
		Next
	Next
	'Load the disks based on the skill level.
	If Skill = wxID_EASY Then
		'4 disks
		For i = 1 to 4
			'Disks must be inside outer cells
			x = Rnd(6) + 1
			y = Rnd(6) + 1
			'Make sure we don't put a disk in an occupied cell
			While Disks[x,y] = 1
				x = Rnd(6) + 1
				y = Rnd(6) + 1
			End While
			hdDisks += 1
			Disks[x,y] = 1
		Next
	ElseIf Skill = wxID_MEDIUM Then
		'5 disks
		For i = 1 to 5 
			x = Rnd(6) + 1
			y = Rnd(6) + 1
			While Disks[x,y] = 1
				x = Rnd(6) + 1
				y = Rnd(6) + 1
			End While	
			hdDisks += 1
			Disks[x,y] = 1
		Next
	Else
		'6 disks
		For i = 1 to 6 
			x = Rnd(6) + 1
			y = Rnd(6) + 1
			While Disks[x,y] = 1
				x = Rnd(6) + 1
				y = Rnd(6) + 1
			End While	
			hdDisks += 1
			Disks[x,y] = 1
		Next
	End If
End Sub

' callback for the New menu option
Sub OnNew( event )
    InitBoard()
    HideDisks()
    ShowBoard()
	frame.SetStatusText("")
	InGame = 1
	NewColor = 0
End Sub
Connect( frame, wxID_NEW, wxEVT_COMMAND_MENU_SELECTED, "OnNew" )

Sub OnPath( event )
	If ShowPath = 0 Then
		'Set the skill setting
		mSettings.Check( wxID_PATH, 1 )
		ShowPath = 1
	Else
		'Set the skill setting
		mSettings.Check( wxID_PATH, 0 )
		ShowPath = 0
	End If
End Sub
Connect( frame, wxID_PATH, wxEVT_COMMAND_MENU_SELECTED, "OnPath" )


//Event Sub for the Show_Disks menu option
Sub OnMenuShow_Disks ( event )
	Dim coord[]
	Dim i,j
	Dim x = 0, 
		y = 0
	Dim temp = ""
	Dim cnt1 = 0
	Dim cnt2 = 0
	'Blue color
	bmpDC.SetPen( BoardPens[4] )
	'Look for the disks
	For i = 1 To 8
		For j = 1 To 8
			'Do we have a disk?
			If Disks[i,j] = 1 Then
				'Inc the disk counter
				cnt1 += 1
				'Did the player mark this disk?
				If Board[i,j] = 1 Then
					'Inc the player disk counter
					cnt2 += 1
				End If
				'Get the coordinates of the cell
				temp = BoardCO[i,j]
				'coord saved as string in x,y format
				Split(coord[], temp, ",")
				x = coord[0] 
				y = coord[1]
				'Draw a blue circle in the cell
				bmpDC.DrawRoundedRectangle(x, y, CellHW, CellHW, 20)
			End If
		Next
	Next
	'Show the disks
	InGame = 0
	ShowBoard()
	frame.SetStatusText("You found " & cnt2 & " of " & cnt1 & " disks.")
End Sub
Connect( frame, wxID_SHOWDISKS, wxEVT_COMMAND_MENU_SELECTED, "OnMenuShow_Disks" )

//Event Sub for the Exit menu option
Sub OnMenuExit ( event )
	End
End Sub
Connect( frame, wxID_EXIT, wxEVT_COMMAND_MENU_SELECTED, "OnMenuExit" )
Connect( frame, wxEVT_CLOSE_WINDOW, "OnMenuExit" )

//Event Sub for the Easy menu option
Sub OnMenuEasy ( event )
	'Set the skill setting
	mSettings.Check( Skill, 0 )
	Skill = wxID_EASY
	mSettings.Check( Skill, 1 )
    InitBoard()
    HideDisks()
    ShowBoard()
	InGame = 1
End Sub
Connect( frame, wxID_EASY, wxEVT_COMMAND_MENU_SELECTED, "OnMenuEasy" )

//Event Sub for the Medium menu option
Sub OnMenuMedium ( event )
	'Set the skill setting
	mSettings.Check( Skill, 0 )
	Skill = wxID_MEDIUM
	mSettings.Check( Skill, 1 )
    InitBoard()
    HideDisks()
    ShowBoard()
	InGame = 1
End Sub
Connect( frame, wxID_MEDIUM, wxEVT_COMMAND_MENU_SELECTED, "OnMenuMedium" )

//Event Sub for the Hard menu option
Sub OnMenuHard ( event )
	'Set the skill setting
	mSettings.Check( Skill, 0 )
	Skill = wxID_HARD
	mSettings.Check( Skill, 1 )
    InitBoard()
    HideDisks()
    ShowBoard()
	InGame = 1
End Sub
Connect( frame, wxID_HARD, wxEVT_COMMAND_MENU_SELECTED, "OnMenuHard" )

'Startup
InitBoard()
HideDisks()
ShowBoard()
'Show the frame.
frame.Show(True)