'Eight Ball Champv3.1LE
'VPMame Conversion by
'Kurt Herman
'scapino@nwlink.com
'Second Special Release Version 3.1
'April 15, 2002
'Eight BallChamp - Bally - 1982

Option Explicit
LoadVPM "01110000", "6803.VBS", 3.00

'***********************************************************
'****				INITIALIZE TABLE					****
'***********************************************************
Dim bsTrough,dtDrop1,dtDrop2,dtDrop3,dtDrop4,dtDrop5,bsSaucer
Dim VPMStarted

Sub LoadVPM(VPMver, VBSfile, VBSver)
	On Error Resume Next
		If ScriptEngineMajorVersion < 5 Then MsgBox "VB Script Engine 5.0 or higher required"
		ExecuteGlobal GetTextFile(VBSFile)
		If Err Then MsgBox "Unable to open " & VBSfile & ". Ensure that it is in the same folder as this table. " & vbNewLine & Err.Description
		Set Controller = CreateObject("VPinMAME.Controller")
		If Err Then	MsgBox "Unable to load VPinMAME." & vbNewLine & Err.Description
		If VPMver > "" Then
			If Controller.Version < VPMver Then MsgBox "This table requires VPinMAME ver " & VPMver & " or higher."
		End If
		If VPinMAMEDriverVer < VBSver Then MsgBox "This table requires " & VBSFile & " ver " & VBSver & " or higher."
	On Error Goto 0
End Sub

Sub InitVPM()
	Set LampCallback = GetRef("UpdateMultipleLamps")
	Set MotorCallback = GetRef("UpdateSolinoids")
	With Controller
		.GameName="eballchp"   ' PinMAME short name
		.SplashInfoLine="Eight Ball Champ Visual PinMame table by Kurt Herman 'scapino'"
		.HandleKeyboard=0
		.ShowTitle=0
		.ShowDMDOnly=1
		.ShowFrame=0
		'.SetDisplayPosition 640,0,GetPlayerHWnd
		On Error Resume Next
			.Run
			If Err Then MsgBox Err.Description
		On Error Goto 0
	End With
	' Main Timer init
	PinMAMETimer.Interval = 1
	PinMAMETimer.Enabled = True
	PulseTimer.Enabled = True
	' Nudging
	vpmNudge.TiltSwitch=15
	vpmNudge.Sensitivity=1
	vpmNudge.TiltObj=Array(LeftBumper,RightBumper,LeftSling,RightSling)

	Set bsTrough = New cvpmBallStack ' Trough handler
	bsTrough.InitSw 0,8,0,0,0,0,0,0
	bsTrough.InitKick Drain,55,10
	bsTrough.InitExitSnd "BALLIN","BALLIN"
	bsTrough.Balls = 1

	Set dtDrop1=New cvpmDropTarget
	dtDrop1.InitDrop Array(EDropTarget),30
	dtDrop1.InitSnd "DROPTARG","Kicker"

	Set dtDrop2=New cvpmDropTarget
	dtDrop2.InitDrop Array(IDropTarget),25
	dtDrop2.InitSnd "DROPTARG","Kicker"

	Set dtDrop3=New cvpmDropTarget
	dtDrop3.InitDrop Array(GDropTarget),27
	dtDrop3.InitSnd "DROPTARG","Kicker"

	Set dtDrop4=New cvpmDropTarget
	dtDrop4.InitDrop Array(HDropTarget),28
	dtDrop4.InitSnd "DROPTARG","Kicker"

	Set dtDrop5=New cvpmDropTarget
	dtDrop5.InitDrop Array(TDropTarget),31
	dtDrop5.InitSnd "DROPTARG","Kicker"

	Set bsSaucer=New cvpmBallStack
	bsSaucer.InitSaucer Saucer,5,260,10 '5,260,10
	bsSaucer.InitExitSnd "HoleKick","HoleKick"

	TextBox1.text ="Press '5' to add credits." & chr(13) & "Press '1' to start." & chr(13) & "Press 'R' for rules."  & chr(13) & "Press 'S' for Game Settings List."
End Sub

Sub EightBallChamp_Init()
	TextBox1.text =""
	TextBox2.text ="Eight Ball Champ v3.1 LE" & chr(13) & "VPM Conversion by" & chr(13) & "Kurt Herman aka Scapino"
	vpmBallImage = "darkball"
	PlungerPulled = false
	BallOut = True
	InitVPM
End Sub

'***********************************************************
'****				KEYBOARD HANDLER					****
'***********************************************************
Dim PlungerPulled

Sub EightBallChamp_KeyUp(ByVal keycode)

	If KeyUpHandler(KeyCode) Then Exit Sub
    
	If keycode = LeftFlipperKey Then
		PlaySound "FlipperDown"
	End If
    
	If keycode = RightFlipperKey Then 
		PlaySound "FlipperDown"
	End If

	If keycode=PlungerKey Then
		PlaySound "Plunger"
		Plunger.Fire
		PlungerPulled = false
		If BallOut = False then
			PlaySound "PlungerRoll"
		End If
	End If
	
End Sub

Sub EightBallChamp_KeyDown(ByVal keycode)

	If keycode = LeftFlipperKey Then
		PlaySound "FlipperUp"
	End If
    
	If keycode = RightFlipperKey Then
		vpmTimer.PulseSwitch(26),0,0
		PlaySound "FlipperUp"
	End If
	
	If KeyDownHandler(KeyCode) Then
	End If
	
	If keycode = PlungerKey Then
		Plunger.Pullback
		If PlungerPulled = false then
			PlaySound "plungerback"
			PlungerPulled = True
		End If
	End If

	If keycode = 19 then
		DisplayRuleCard
	end if
	
	If keycode = 31 then
		DisplaySettings
	end if

End Sub

'***********************************************************
'****				SOLENOID HANDLERS					****
'***********************************************************

Const UseSolenoids=	1
Const UseLamps=		0
Const UseGI=		0
Const SSolenoidOn=	"Plunger"
Const SSolenoidOff=	""
Const SFlipperOn=	"LFTFLPRP"
Const SFlipperOff=	"LFTFLPRD"
Const SCoin=		"KAKKON"

' Solenoids
Const sBallRelease=	14	'11 
Const sKnocker=		15	'12
Const sSaucer=		8	'1
Const sLeftBumper=	9	'2
Const sRightBumper=	10	'3
Const sLeftSling=	12	'10
Const sRightSling=	11	'9
Const sDropTarget1=	1	'4
Const sDropTarget3=	2	'5
Const sDropTarget4=	3	'8
Const sDropTarget6=	4	'9
Const sDropTarget7=	5	'10
Const sK1Relay=		19	'13

SolCallback(sBallRelease)=	"bsTrough.SolOut"
SolCallback(sKnocker)=		"vpmSolSound ""KNOCK"","
SolCallback(sSaucer)=		"bsSaucer.SolOut"
SolCallback(sLeftBumper)=	"vpmSolSound ""Bumper"","
SolCallback(sRightBumper)=	"vpmSolSound ""Bumper"","
SolCallback(sLeftSling)=	"vpmSolSound ""Bumper"","
SolCallback(sRightSling)=	"vpmSolSound ""Bumper"","
SolCallback(sDropTarget1)=	"dtDrop2.SolDropUp"
SolCallback(sDropTarget3)=	"dtDrop3.SolDropUp"
SolCallback(sDropTarget4)=	"dtDrop4.SolDropUp"
SolCallback(sDropTarget6)=	"dtDrop1.SolDropUp"
SolCallback(sDropTarget7)=	"dtDrop5.SolDropUp"
SolCallback(sK1Relay)=		"vpmNudge.SolGameOn"
solcallback(sllflipper)=	"vpmSolFlipper Leftflipper,Nothing,"
solcallback(slrflipper)=	"vpmsolflipper Rightflipper,MidFlipper,"

Sub UpdateSolinoids

	If Controller.Solenoid(4) = True then
		EDropReel.SetValue(0)
	End If
	
	If Controller.Solenoid(1) = True then
		IDropReel.SetValue(0)
	End If
	
	If Controller.Solenoid(2) = True then
		GDropReel.SetValue(0)
	End If
	
	If Controller.Solenoid(3) = True then
		HDropReel.SetValue(0)
	End If
	
	If Controller.Solenoid(5) = True then
		TDropReel.SetValue(0)
	End If

	If Controller.Solenoid(15) = True then 'knocker credit update
	End If

	If Controller.Solenoid(14) = True then 'ball kicked out of drain
	End If

End Sub

'***********************************************************
'****				GAME WALL/LIGHT HANDLERS			****
'***********************************************************
Dim TheWalls(96)

Set TheWalls(1) = Wall24	'SPSA
Set TheWalls(2) = Wall25	'Credit
Set TheWalls(3) = BlankWall	'Game Over
Set TheWalls(4) = Wall27	'Drop Target 2
Set TheWalls(5) = Wall30	'Drop Target 5
Set TheWalls(6) = Wall72	'Saucer 8-Ball
Set TheWalls(7) = Wall35	'Drop Target 11
Set TheWalls(8) = Wall38	'Drop Target 14
Set TheWalls(9) = Wall1 	'Bonus 1
Set TheWalls(10) = Wall4	'Bonus 4
Set TheWalls(11) = Wall7	'Bonus 7
Set TheWalls(12) = Wall9	'Bonus 10
Set TheWalls(13) = Wall12 	'Bonus 13
Set TheWalls(14) = Wall50	'Eight Ball Awards Special
Set TheWalls(15) = Wall53	'5,000 Drop Target 4/5
Set TheWalls(16) = BlankWall
Set TheWalls(17) = BlankWall'Extra Ball
Set TheWalls(18) = BlankWall'Ball In Play
Set TheWalls(19) = BlankWall'Tilt
Set TheWalls(20) = Wall28	'Drop Target 3
Set TheWalls(21) = Wall31	'Drop Target 6
Set TheWalls(22) = Wall33	'Drop Target 9
Set TheWalls(23) = Wall36 	'Drop Target 12
Set TheWalls(24) = Wall39	'Drop Target 15
Set TheWalls(25) = Wall2	'Bonus 2
Set TheWalls(26) = Wall5 	'Bonus 5
Set TheWalls(27) = Wall15 	'Bonus 8
Set TheWalls(28) = Wall10	'Bonus 11
Set TheWalls(29) = Wall13	'Bonus 14
Set TheWalls(30) = Wall51 	'5,000 Drop Target 1/2
Set TheWalls(31) = Wall54	'5,000 Drop Target 6
Set TheWalls(32) = BlankWall
Set TheWalls(33) = BlankWall'Match
Set TheWalls(34) = BlankWall'High Score to Date
Set TheWalls(35) = Wall26	'Drop Target 1
Set TheWalls(36) = Wall29	'Drop Target 4
Set TheWalls(37) = Wall32	'Drop Target 7
Set TheWalls(38) = Wall34	'Drop Target 10
Set TheWalls(39) = Wall37 	'Drop Target 13
Set TheWalls(40) = BlankWall
Set TheWalls(41) = Wall3	'Bonus 3
Set TheWalls(42) = Wall6	'Bonus 6
Set TheWalls(43) = Wall8	'Bonus 9
Set TheWalls(44) = Wall11	'Bonus 12
Set TheWalls(45) = Wall14	'Bonus 15
Set TheWalls(46) = Wall52 	'5,000 Drop Target 3
Set TheWalls(47) = Wall55	'5,000 Drop Target 7
Set TheWalls(48) = BlankWall
Set TheWalls(49) = Wall74	'C Rollover
Set TheWalls(50) = Wall77	'M Rollover
Set TheWalls(51) = Wall67	'Spinner 3,000
Set TheWalls(52) = Wall46	'A Ball
Set TheWalls(53) = Wall16	'Doubles Playfield Value
Set TheWalls(54) = Wall80	'Right Outlane
Set TheWalls(55) = BlankWall
Set TheWalls(56) = BlankWall
Set TheWalls(57) = Wall73	'Saucer 2X
Set TheWalls(58) = Wall71 	'Saucer 100K
Set TheWalls(59) = Wall20	'5X
Set TheWalls(60) = Wall57	'Rollover Lanes 20,000
Set TheWalls(61) = Wall60	'Rollover Lanes Special
Set TheWalls(62) = Wall18	'Bonus Special
Set TheWalls(63) = Wall42	'G Eight
Set TheWalls(64) = BlankWall
Set TheWalls(65) = Wall75	'H Rollover
Set TheWalls(66) = Wall78 	'P Rollover
Set TheWalls(67) = Wall68	'Spinner 5,000
Set TheWalls(68) = Wall47	'L1 Ball
Set TheWalls(69) = Wall17	'Triples Playfield Value
Set TheWalls(70) = BlankWall
Set TheWalls(71) = BlankWall
Set TheWalls(72) = BlankWall
Set TheWalls(73) = Wall69	'Saucer 3X
Set TheWalls(74) = Wall22	'2X
Set TheWalls(75) = Wall49	'Eight Ball Awards EB
Set TheWalls(76) = Wall58	'Rollover Lanes 30,000
Set TheWalls(77) = Wall23	'Bonus 120,000
Set TheWalls(78) = Wall40	'E Eight
Set TheWalls(79) = Wall43 	'H Eight
Set TheWalls(80) = BlankWall
Set TheWalls(81) = Wall76	'A Rollover
Set TheWalls(82) = Wall66	'Spinner 1,000
Set TheWalls(83) = Wall45	'B Ball
Set TheWalls(84) = Wall48	'L2 Ball
Set TheWalls(85) = Wall79	'Left Outlane
Set TheWalls(86) = BlankWall
Set TheWalls(87) = BlankWall
Set TheWalls(88) = BlankWall
Set TheWalls(89) = Wall70	'Saucer 5X
Set TheWalls(90) = Wall21	'3X
Set TheWalls(91) = Wall56	'Rollover Lanes 10,000
Set TheWalls(92) = Wall59	'Rollover Lanes 40,000
Set TheWalls(93) = Wall19	'Bonus 240,000
Set TheWalls(94) = Wall41	'I Eight
Set TheWalls(95) = Wall44	'T Eight
Set TheWalls(96) = BlankWall	

Sub UpdateMultipleLamps
Dim temp, temp2, changed

	changed = Controller.ChangedLamps
	temp = UBound(changed)

	For Temp2 = 0 to temp
		TheWalls(changed(temp2,0)).IsDropped = changed(temp2,1)
	next

	Wall61.IsDropped = Wall56.IsDropped
	Wall62.IsDropped = Wall57.IsDropped
	Wall63.IsDropped = Wall58.IsDropped
	Wall64.IsDropped = Wall59.IsDropped
	Wall65.IsDropped = Wall60.IsDropped

End Sub


'***********************************************************
'****				MYGAME INTERFACE CODE				****
'***********************************************************

Dim BallOut

Sub BallOutTrigger_Hit()
	ActiveBall.Image = "goldball"
	BallOut = True
End Sub

Sub Drain_Hit()
	ActiveBall.Image = "darkball"
	PlaySound "drain"
	bsTrough.AddBall ME
End Sub

'***********************************************************
'****				TOP RAIL CODE						****
'***********************************************************

Sub PreTrigger_Init()
	PreTrigger.IsDropped = False
End Sub

Sub PreTrigger_Hit()
	PreTrigger.IsDropped = True
End Sub

Sub TopDropRail_Init()
	TopDropRail.IsDropped = False
End Sub

Sub BottomDropRail_Init()
	BottomDropRail.IsDropped = False
End Sub

Sub TopDropRail_Hit()
	TopDropRail.IsDropped = True
	BottomDropRail.IsDropped = True
End Sub

Sub CloseRail_Hit()
	TopDropRail.IsDropped = False
	BottomDropRail.IsDropped = False
	PreTrigger.IsDropped = False
End Sub


'***********************************************************
'****					SAUCER CODE						****
'***********************************************************

Sub Saucer_Hit()
	PlaySound "BallInSaucer"
	bsSaucer.AddBall Me
End Sub

'***********************************************************
'****					DROP TARGET CODE				****
'***********************************************************

Sub EDropTarget_Hit()
	EDropReel.SetValue(1)
	dtDrop1.hit 1
End Sub

Sub IDropTarget_Hit()
	IDropReel.SetValue(1)
	dtDrop2.hit 1
End Sub

Sub GDropTarget_Hit()
	GDropReel.SetValue(1)
	dtDrop3.hit 1
End Sub

Sub HDropTarget_Hit()
	HDropReel.SetValue(1)
	dtDrop4.hit 1
End Sub

Sub TDropTarget_Hit()
	TDropReel.SetValue(1)
	dtDrop5.hit 1
End Sub
'***********************************************************
'****				FIXED TARGET CODE					****
'***********************************************************

Sub EFixedTarget_Hit()
	vpmTimer.PulseSwitch(33),0,0
End Sub

Sub IFixedTarget_Hit()
	vpmTimer.PulseSwitch(34),0,0
End Sub

Sub GFixedTarget_Hit()
	vpmTimer.PulseSwitch(35),0,0
End Sub

Sub HFixedTarget_Hit()
	vpmTimer.PulseSwitch(36),0,0
End Sub

Sub TFixedTarget_Hit()
	vpmTimer.PulseSwitch(37),0,0
End Sub

'***********************************************************
'****				ROLLOVER SWITCH CODE				****
'***********************************************************

Sub TopLeftChuteRollover_Hit()
	controller.switch (12)=true
End Sub

Sub TopLeftChuteRollover_unHit():controller.switch (12)=false:End Sub

Sub TopRightChuteRollover_Hit()
	controller.switch (13)=true
End Sub

Sub TopRightChuteRollover_unHit():controller.switch (13)=false:End Sub

Sub TriggerCenterRollover_Hit()
	controller.switch (29)=true
End Sub

Sub TriggerCenterRollover_unHit():controller.switch (29)=false:End Sub

'***********************************************************
'****					SLING CODE						****
'***********************************************************

Sub RightSling_SlingShot()
	vpmTimer.PulseSwitch(3),0,0
End Sub

Sub LeftSling_SlingShot()
	vpmTimer.PulseSwitch(4),0,0 
End Sub

'***********************************************************
'****					SPINNER CODE					****
'***********************************************************

Sub Spinner1_Spin()
	vpmTimer.PulseSwitch(32),0,0
End Sub

'***********************************************************
'****					BUMPER CODE						****
'***********************************************************

Sub RightBumper_Hit()
	vpmTimer.PulseSwitch(1),0,0
	RightBumpReel.SetValue(1)
	RightBumper.TimerInterval = 100
	RightBumper.TimerEnabled= True
End Sub

Sub RightBumper_Timer()
	RightBumpReel.SetValue(0)
	RightBumper.TimerEnabled= False
End Sub

Sub LeftBumper_Hit()
	vpmTimer.PulseSwitch(2),0,0
	LeftBumpReel.SetValue(1)
	LeftBumper.TimerInterval = 100
	LeftBumper.TimerEnabled= True
End Sub

Sub LeftBumper_Timer()
	LeftBumpReel.SetValue(0)
	LeftBumper.TimerEnabled= False
End Sub

Sub TenPointer_Hit()
	vpmTimer.PulseSwitch(7),0,0
End Sub


'***********************************************************
'****				CHAMP LANES CODE					****
'***********************************************************

Sub CLaneTrigger_Hit()
	controller.switch (17)=true
End Sub

Sub CLaneTrigger_unHit():controller.switch (17)=false:End Sub

Sub HLaneTrigger_Hit()
	controller.switch (18)=true
End Sub

Sub HLaneTrigger_unHit():controller.switch (18)=false:End Sub

Sub ALaneTrigger_Hit()
	controller.switch (19)=true
End Sub
Sub ALaneTrigger_unHit():controller.switch (19)=false:End Sub

Sub MLaneTrigger_Hit()
	controller.switch (20)=true
End Sub

Sub MLaneTrigger_unHit():controller.switch (20)=false:End Sub

Sub PLaneTrigger_Hit()
	controller.switch (21)=true
End Sub

Sub PLaneTrigger_unHit():controller.switch (21)=false:End Sub

'***********************************************************
'****					OUTLANES CODE					****
'***********************************************************
Sub LeftSpecTrigger_Hit()
	controller.switch (23)=true
End Sub

Sub LeftSpecTrigger_unHit():controller.switch (23)=false:End Sub

Sub RightSpecTrigger_Hit()
	controller.switch (24)=true
End Sub

Sub RightSpecTrigger_unHit():controller.switch (24)=false:End Sub

'***********************************************************
'****				TEXT BOX DISPLAY CODE				****
'***********************************************************

Sub DisplayRuleCard
	MsgBox "1 to 4				INSTRUCTIONS					FOR" & CHR(13) & "CAN PLAY								AMUSEMENT" & CHR(13) & "									          ONLY" & CHR(13) & CHR(13) & "	*1st and 3rd players play solid balls 1 thru 7, 2nd and 4th players play striped balls"& CHR(13) & "	 9 thru 15. Player completing all solid or striped balls may play the 8 ball." & CHR(13) & CHR(13) & "	* Completing 'C-H-A-M-P' increases spinner value. 1st time doubles all playfield" & CHR(13) & "	 score values. 2nd time triples values, 3rd time lites outlanes alternately to score" & CHR(13) & "	 'Special', 4th time both outlanes flash to score 'Special'." & CHR(13) & CHR(13) & "	*1 Replay for making '8-Ball' when 'Special' lite is lit." & CHR(13) & CHR(13) & "	*1 Replay for completing 'E-I-G-H-T' when 'Special' lite is flashing." & CHR(13) & CHR(13) & "	*1 Replay for ball thru either outlanes when 'Special' lite is flashing." & CHR(13) & CHR(13) & "	*1 Replay for ball thru either rollup lane when 'Special' lite is flashing." & CHR(13) & CHR(13) & "	*1 'Extra Ball' for completing 'E-I-G-H-T' when 'Extra Ball' lite is flashing." & CHR(13) & CHR(13) & "	*1 'Extra Ball' per ball in play." & CHR(13) & CHR(13) & "	*Tilt penalty ball in play." & CHR(13),0,"Eight Ball Champ Rules"
End Sub

Sub DisplaySettings
	MsgBox "Register 12 = First Scoreing Threshold - set from 0 -9,999,999" & chr(13) &"Register 13 = Second Scoreing Threshold - set from 0 -9,999,999" & chr(13) &"Register 14 = Third Scoreing Threshold - set from 0 -9,999,999" & chr(13) &"Register 15 = HighScoreTo Date - set from 0 -9,999,999" & chr(13) &"Register 23 = Balls Per Game- set from 0 - 5" & chr(13) & chr(13) &"Register 24 = HighScore/Treshold Award" & chr(13) &"0 = No Award" & chr(13) &"1 = Novelty" & chr(13) &"2 = ExtraBall" & chr(13) &"3 = Replay" & chr(13) & chr(13) &"Register 25 = Playfield Specials Award" & chr(13) &"0 = No Award" & chr(13) &"1 = Novelty" & chr(13) &"2 = ExtraBall" & chr(13) &"3 = Replay",0,"Eight Ball Champ Settings"
End Sub