Option Explicit
Const cScriptVersion = 0.1
Const cMinTableVersion = 0.1
LoadVPM "00990300", "S6.VBS", 1.0
Dim cCredits
cCredits            = cScriptName & " Table version " & cTableVersion & " Designed by " & cAuthor 
'------------------------------------------------
' parameters of the game
Const cGameName     = "blkou_l1"	' PinMAME short name
Const UseSolenoids  = True		' solenoids are used
Const UseLamps      = True		' lights too
Const cHandleMechanic = 0		' no toys
Const SSolenoidOn   = ""'Solenoid"
Const SSolenoidOff  = ""
Const SFlipperOn    = ""'FlipperUp"
Const SFlipperOff   = ""'FlipperDown"
Const SBallRelease  = ""'BallRelease"
Const SKnocker	    = "Knocker"
'------------------------------------------------
' lights, map all lights on the playfield to the Lights array
Dim i
For i=1 To 64
	Execute "Set Lights(" & i & ")  = Light" & i
Next
'------------------------------------------------
' solenoids, map events to each solenoid number
SolCallback(1) = "bsTrough.SolOut"		' eject from starting lane
SolCallback(4) = "btCenter3Target.SolDropUp"	' reset the 3 center targets
SolCallback(5) = "btUpper3Target.SolDropUp"	' reset the 3 upper targets
SolCallback(6) = "bsSaucer.SolOut"		' eject from the kicker
SolCallback(14) = "vpmSolSound sKnocker,"	' make some sound
SolCallback(23) = "vpmNudge.SolGameOn"		' active/inactive playfield objects
SolCallback(sLRFlipper) = "SolFlipper RightFlipper,Nothing,"	' right flipper
SolCallback(sLLFlipper) = "SolFlipper LeftFlipper,Nothing,"	' left flipper
'------------------------------------------------
' switches: my routine, waiting the array of object by type in vp
Execute borisAddTrigger(0,5,"Drain","bsTrough",Nothing)			' kicker
Execute borisAddTrigger(0,5,"Trigger9","bsTrough",Nothing)		' kicker
Execute borisAddTrigger(10,1,"Trigger10",Nothing,Nothing)		' trigger
Execute borisAddTrigger(11,2,"Trigger11",Nothing,Nothing)		' target
Execute borisAddTrigger(12,2,"Trigger12",Nothing,Nothing)		' target
Execute borisAddTrigger(13,2,"Trigger13",Nothing,Nothing)		' target
Execute borisAddTrigger(14,2,"Trigger14",Nothing,Nothing)		' target
Execute borisAddTrigger(15,2,"Trigger15",Nothing,Nothing)		' target
Execute borisAddTrigger(18,6,"Trigger18",Nothing,Nothing)		' spinner
Execute borisAddTrigger(19,3,"Trigger19",Nothing,Nothing)		' slingshot
Execute borisAddTrigger(20,2,"Trigger20",Nothing,Nothing)		' target
Execute borisAddTrigger(21,2,"Light21",Nothing,Nothing)			' bumper
Execute borisAddTrigger(22,2,"Light22",Nothing,Nothing)			' bumper
Execute borisAddTrigger(23,2,"Light23",Nothing,Nothing)			' bumper
Execute borisAddTrigger(0,4,"Trigger25","btCenter3Target",1)		' target drop
Execute borisAddTrigger(0,4,"Trigger26","btCenter3Target",2)		' target drop
Execute borisAddTrigger(0,4,"Trigger27","btCenter3Target",3)		' target drop
Execute borisAddTrigger(29,1,"Trigger29",Nothing,Nothing)		' trigger
Execute borisAddTrigger(30,1,"Trigger30",Nothing,Nothing)		' trigger
Execute borisAddTrigger(31,1,"Trigger31",Nothing,Nothing)		' trigger
Execute borisAddTrigger(0,4,"Trigger33","btUpper3Target",1)		' target drop
Execute borisAddTrigger(0,4,"Trigger34","btUpper3Target",2)		' target drop
Execute borisAddTrigger(0,4,"Trigger35","btUpper3Target",3)		' target drop
Execute borisAddTrigger(37,6,"Trigger37",Nothing,Nothing)		' spinner
Execute borisAddTrigger(38,3,"Trigger38",Nothing,Nothing)		' slingshot
Execute borisAddTrigger(39,6,"Trigger39",Nothing,Nothing)		' spinner
Execute borisAddTrigger(40,5,"Trigger40","bsSaucer",Nothing)		' kicker
Execute borisAddTrigger(41,1,"Trigger41",Nothing,Nothing)		' trigger
Execute borisAddTrigger(42,1,"Trigger42",Nothing,Nothing)		' trigger
Execute borisAddTrigger(43,3,"Trigger43",Nothing,Nothing)		' slingshot
Execute borisAddTrigger(44,3,"Trigger44",Nothing,Nothing)		' slingshot
Execute borisAddTrigger(45,1,"Trigger45",Nothing,Nothing)		' trigger
Execute borisAddTrigger(46,1,"Trigger46",Nothing,Nothing)		' trigger
'------------------------------------------------
' init the table
Dim bsTrough,bsSaucer			' for kickers
Dim btCenter3Target,btUpper3Target	' for drop targets
Sub BO_Init()
	On Error Resume Next
	If cMinScriptVersion > cScriptVersion Then
		MsgBox "This table requires """ & cScriptName & ".vbs"" ver " & cMinScriptVersion & " or higher." & vbCrLf & "You have the version " & cScriptVersion & ".": Exit Sub
	End If
	If cMinTableVersion > cTableVersion Then
		MsgBox "The design version of the table """ & cScriptName & """ need to be version " & cMinTableVersion & " or higher for this script engine." & vbCrLf & "You have the version " & cTableVersion & " of the table.": Exit Sub
	End If
	With Controller
		.GameName = cGameName
		If Err Then MsgBox "Can't start Game" & cGameName & vbNewLine & Err.Description : Exit Sub
		.SplashInfoLine = cCredits
		.HandleMechanics = cHandleMechanic
		.ShowDMDOnly = True
		.ShowFrame = False
		.ShowTitle = False
		.SetDisplayPosition 24,126,GetPlayerHWnd
		.Run
		If Err Then MsgBox Err.Description
	End With
	On Error Goto 0
	PinMAMETimer.Interval = PinMAMEInterval
	PinMAMETimer.Enabled = True
	vpmNudge.TiltSwitch = swTilt
	vpmNudge.Sensitivity = 5

	' objects that could be activate/inactivate
	vpmNudge.TiltObj = Array(Light25,Light26,Light27,Trigger43,Trigger44,Trigger19,Trigger38)
	' balls in starting lane
	Set bsTrough = New cvpmBallStack
	bsTrough.InitSw 0,9,0,0,0,0,0,0
	bsTrough.InitKick Trigger9,160,1
	bsTrough.Balls = 1
	' balls in saucer
	Set bsSaucer = New cvpmBallStack
	bsSaucer.InitSaucer Trigger40,40,220,3
	' Center 3 target
	Set btCenter3Target = New cvpmDropTarget
	btCenter3Target.InitDrop Array(Trigger25,Trigger26,Trigger27),Array(25,26,27)
	btCenter3Target.AllDownSw=28
	' Upper 3 target
	Set btUpper3Target = New cvpmDropTarget
	btUpper3Target.InitDrop Array(Trigger33,Trigger34,Trigger35),Array(33,34,35)
	btUpper3Target.AllDownSw=36
End Sub
'------------------------------------------------
' keyboard
Sub BO_KeyUp(ByVal keycode)
	If vpmKeyUp(keycode) Then Exit Sub
	If keycode = PlungerKey Then Plunger.Fire
End Sub
Sub BO_KeyDown(ByVal keycode)
	If vpmKeyDown(keycode) Then Exit Sub
	If keycode = PlungerKey Then Plunger.Pullback
End Sub
'------------------------------------------------
'Execute borisAddTrigger(p1,p2,"p3","p4",p5)
' p1=switch number (only need for p2=1, 2, 3 or 6)
' p2=type
' 	1 = hit and unhit event
' 	2 = only hit event, so do a pulseswitch
' 	3 = slingshot, so do a pulseswitch
' 	4 = drop target
'	5 = kicker hole
' 	6 = spinner, so do a pulseswitch
' p3=visual pinball object name
' if p2 in (1,2,3,6) then p4 and p5 = Nothing
' If p2=4
'	p4=var name of the cvpmDropTarget
' 	p5=number of the target (1,2,...)
' If p2=5
'	p4=var name of the cvpmBallStack
'	p5=Nothing
Function borisAddTrigger(ByVal no,ByVal tp,ByVal objname,ByVal targetname,ByVal targetnumber)
	Dim tmp
	tmp=""
	Select Case tp
		Case 1:	
			tmp = "Sub " & objname & "_Hit" & vbCrLf
			tmp = tmp & "Controller.Switch(" & no & ")=True" & vbCrLf
			tmp = tmp & "End Sub" & vbCrLf
			tmp = tmp & "Sub " & objname & "_UnHit" & vbCrLf
			tmp = tmp & "Controller.Switch(" & no & ")=False" & vbCrLf
			tmp = tmp & "End Sub"
		Case 2:	
			tmp = "Sub " & objname & "_Hit" & vbCrLf
			tmp = tmp & "vpmTimer.PulseSwitch " & no & ",0,0" & vbCrLf
			tmp = tmp & "End Sub" & vbCrLf
		Case 3:	
			tmp = "Sub " & objname & "_SlingShot" & vbCrLf
			tmp = tmp & "vpmTimer.PulseSwitch " & no & ",0,0" & vbCrLf
			tmp = tmp & "End Sub" & vbCrLf
		Case 4:	
			tmp = "Sub " & objname & "_Hit" & vbCrLf
			tmp = tmp & targetname & ".Hit " & targetnumber & vbCrLf
			tmp = tmp & "End Sub" & vbCrLf
		Case 5:	
			tmp = "Sub " & objname & "_Hit" & vbCrLf
			tmp = tmp & targetname & ".AddBall Me" & vbCrLf
			tmp = tmp & "End Sub" & vbCrLf
		Case 6:	
			tmp = "Sub " & objname & "_Spin" & vbCrLf
			tmp = tmp & "vpmTimer.PulseSwitch " & no & ",0,0" & vbCrLf
			tmp = tmp & "End Sub" & vbCrLf
	End Select
	borisAddTrigger=tmp
End Function
Sub LoadVPM(VPMver, VBSfile, VBSver)
	On Error Resume Next
		If ScriptEngineMajorVersion < 5 Then
			MsgBox "VB Script Engine 5.0 or higher required"
		End If
		ExecuteGlobal CreateObject("Scripting.FileSystemObject").OpenTextFile(VBSfile, 1).ReadAll
		If Err Then 
			MsgBox "Unable to open " & VBSfile & ". Ensure that it is in the same folder as this table. " & vbNewLine & Err.Description
		End If
		Set Controller = CreateObject("VPinMAME.Controller")
		If Err Then
			MsgBox "Unable to load VPinMAME." & vbNewLine & Err.Description
		End If
		If VPMver > "" Then
			If Controller.Version < VPMver Or Err Then
				MsgBox "This table requires VPinMAME ver " & VPMver & " or higher."
			End If
		End If
		If VPinMAMEDriverVer < VBSver Or Err Then
			MsgBox "This table requires " & VBSFile & " ver " & VBSver & " or higher."
		End If
	On Error Goto 0
End Sub
