Option Explicit
Const cScriptVersion = 0.3
Const cMinTableVersion = 0.3
LoadVPM "00990300", "S4.VBS", 1.1
Dim cCredits
cCredits            = cScriptName & " Table version " & cTableVersion & " Designed by " & cAuthor 
'------------------------------------------------
' parameters of the game
Const cGameName     = "tmwrp_l2"	' 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(2)	= "bsLeft.SolOut"		' eject from the left kicker
SolCallback(3)	= "bsRight.SolOut"		' eject from the right kicker
SolCallback(4)	= "bt3Target.SolDropUp"		' reset the 3 targets
SolCallback(6)	= "bt5Target.SolDropUp"		' reset the 5 targets
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,3,"Trigger10",Nothing,Nothing)	' slingshot
Execute borisAddTrigger(11,3,"Trigger11",Nothing,Nothing)	' slingshot
Execute borisAddTrigger(12,1,"Trigger12",Nothing,Nothing)	' trigger
Execute borisAddTrigger(13,1,"Trigger13",Nothing,Nothing)	' trigger
Execute borisAddTrigger(14,1,"Trigger14",Nothing,Nothing)	' trigger
Execute borisAddTrigger(0,5,"Trigger15","bsLeft",Nothing)	' kicker
Execute borisAddTrigger(16,2,"Trigger16",Nothing,Nothing)	' target
Execute borisAddTrigger(17,2,"Trigger17",Nothing,Nothing)	' target
Execute borisAddTrigger(18,1,"Trigger18",Nothing,Nothing)	' trigger
Execute borisAddTrigger(19,2,"Trigger19",Nothing,Nothing)	' bumper
Execute borisAddTrigger(20,2,"Trigger20",Nothing,Nothing)	' bumper
Execute borisAddTrigger(21,2,"Trigger21",Nothing,Nothing)	' bumper
Execute borisAddTrigger(22,2,"Trigger22",Nothing,Nothing)	' bumper
Execute borisAddTrigger(23,2,"Trigger23",Nothing,Nothing)	' bumper
Execute borisAddTrigger(0,5,"Trigger24","bsRight",Nothing)	' kicker
Execute borisAddTrigger(0,4,"Trigger25","bt5Target",1)		' target drop
Execute borisAddTrigger(0,4,"Trigger26","bt5Target",2)		' target drop
Execute borisAddTrigger(0,4,"Trigger27","bt5Target",3)		' target drop
Execute borisAddTrigger(0,4,"Trigger28","bt5Target",4)		' target drop
Execute borisAddTrigger(0,4,"Trigger29","bt5Target",5)		' target drop
Execute borisAddTrigger(32,3,"Trigger32","bsPit",Nothing)	' slingshot
Execute borisAddTrigger(0,4,"Trigger33","bt3Target",1)		' target drop
Execute borisAddTrigger(0,4,"Trigger34","bt3Target",2)		' target drop
Execute borisAddTrigger(0,4,"Trigger35","bt3Target",3)		' target drop
Execute borisAddTrigger(38,3,"Trigger38",Nothing,Nothing)	' slingshot
Execute borisAddTrigger(39,1,"Trigger39",Nothing,Nothing)	' trigger
Execute borisAddTrigger(40,1,"Trigger40",Nothing,Nothing)	' trigger
Execute borisAddTrigger(41,3,"Trigger41",Nothing,Nothing)	' slingshot
Execute borisAddTrigger(42,3,"Trigger42",Nothing,Nothing)	' slingshot
Execute borisAddTrigger(44,1,"Trigger41",Nothing,Nothing)	' trigger
'------------------------------------------------
' init the table
Dim bsTrough,bsLeft,bsRight	' for kickers
Dim bt3Target,bt5Target		' for drop targets
Sub TW_Init()			' init the table
	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(Trigger19,Trigger20,Trigger21,Trigger22,Trigger23,Trigger10,Trigger11,Trigger32,Trigger38,Trigger41,Trigger42)
	' 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
	' ball in left kicker
	Set bsLeft= New cvpmBallStack
	bsLeft.InitSaucer Trigger15,15,205,4
	' ball in right kicker
	Set bsRight= New cvpmBallStack
	bsRight.InitSaucer Trigger24,24,315,5
	' 3 targets
	Set bt3Target = New cvpmDropTarget
	bt3Target.InitDrop Array(Trigger33,Trigger34,Trigger35),Array(33,34,35)
	bt3Target.AnyUpSw=37
	bt3Target.AllDownSw=36
	' 5 targets
	Set bt5Target = New cvpmDropTarget
	bt5Target.InitDrop Array(Trigger25,Trigger26,Trigger27,Trigger28,Trigger29),Array(25,26,27,28,29)
	bt5Target.AnyUpSw=31
	bt5Target.AllDownSw=30
End Sub
'------------------------------------------------
' keyboard : nothing special
Sub TW_KeyUp(ByVal keycode)
	If vpmKeyUp(keycode) Then Exit Sub
	If keycode = PlungerKey Then Plunger.Fire
End Sub
Sub TW_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
