Option Explicit
Const cScriptVersion = 0.1
Const cMinTableVersion = 0.5
LoadVPM "00990300", "S6.VBS", 1.1
Dim cCredits
cCredits            = cScriptName & " Table version " & cTableVersion & " Designed by " & cAuthor 
'------------------------------------------------
' parameters of the game
Const cGameName     = "grgar_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"
Const BallImage     = "shinyball"
'------------------------------------------------
' lights, map all lights on the playfield to the Lights array
Dim i
	Set Lights(1) = Light11
	Set Lights(2) = Light12
	Set Lights(3) = Light13
	Set Lights(4) = Light14
	Set Lights(5) = Light15
	Set Lights(6) = Light16
	Set Lights(7) = Light17
	Set Lights(8) = Light18
	Set Lights(9) = Light21
	Set Lights(10) = Light22
	Set Lights(11) = Light23
	Set Lights(12) = Light24
	Set Lights(13) = Light25
	Set Lights(14) = Light26
	Set Lights(15) = Light27
	Set Lights(16) = Light28
	Set Lights(17) = Light31
	Set Lights(18) = Light32
	Set Lights(19) = Light33
	Set Lights(20) = Light34
	Set Lights(21) = Light35
	Set Lights(22) = Light36
	Set Lights(23) = Light37
	Set Lights(24) = Light38
	Set Lights(25) = Light41
	Set Lights(26) = Light42
	Set Lights(27) = Light43
	Set Lights(28) = Light44
	Set Lights(29) = Light45
	Set Lights(30) = Light46
	Set Lights(31) = Light47
	Set Lights(32) = Light48
	Set Lights(33) = Light51
	Set Lights(34) = Light52
	Set Lights(35) = Light53
	Set Lights(36) = Light54
	Set Lights(37) = Light55
	Set Lights(38) = Trigger55
	Set Lights(39) = Trigger56
	Set Lights(40) = Trigger57
	Set Lights(41) = Light61
	Set Lights(42) = Light62
	Set Lights(43) = Light63
	Set Lights(44) = Light64
	Set Lights(45) = Light65
	Set Lights(46) = Light66
'	Set LightObj(47) = Light67
	Set Lights(48) = Light68
'	Set LightObj(49) = Light71
	Set Lights(50) = Light72
	Set Lights(51) = Light73
	Set Lights(52) = Light74
	Set Lights(53) = Light75
	Set Lights(54) = Light76
	Set Lights(55) = Light77
	Set Lights(56) = Light78
	Set Lights(57) = Light81
	Set Lights(58) = Light82
	Set Lights(59) = Light83
	Set Lights(60) = Light84
	Set Lights(61) = Light85
	Set Lights(62) = Light86
	Set Lights(63) = Light87
	Set Lights(64) = Light88
'------------------------------------------------
' solenoids, map events to each solenoid number
SolCallback(1) = "bsTrough.SolOut"			' eject from starting lane
SolCallback(2) = "bsSaucer.SolOut"			' eject from left kicker
SolCallback(3) = "btCenterTarget.SolDropUp"		' reset the 3 center targets
SolCallback(4) = "btUpperTarget.SolDropUp"		' reset the 3 upper targets
SolCallback(5) = "bsPit.SolOut"				' eject from upper kicker
SolCallback(6) = "vpmFlasher GIFlasher,"		' lit on/off flasher
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
Execute borisAddTrigger(0,5,"Drain","bsTrough",Nothing)		' kicker
Execute borisAddTrigger(0,5,"Trigger21","bsTrough",Nothing)	' kicker
Execute borisAddTrigger(10,1,"Trigger22",Nothing,Nothing)	' trigger
Execute borisAddTrigger(11,1,"Trigger23",Nothing,Nothing)	' trigger
Execute borisAddTrigger(12,3,"Trigger24",Nothing,Nothing)	' slingshot
Execute borisAddTrigger(13,3,"Trigger25",Nothing,Nothing)	' slingshot
Execute borisAddTrigger(14,2,"Trigger26",Nothing,Nothing)	' trigger
Execute borisAddTrigger(0,5,"Trigger27","bsSaucer",Nothing)	' kicker
Execute borisAddTrigger(16,3,"Trigger28",Nothing,Nothing)	' slingshot
Execute borisAddTrigger(17,3,"Trigger31",Nothing,Nothing)	' slingshot
Execute borisAddTrigger(0,4,"Trigger32","btUpperTarget",1)	' target drop
Execute borisAddTrigger(0,4,"Trigger33","btUpperTarget",2)	' target drop
Execute borisAddTrigger(0,4,"Trigger34","btUpperTarget",3)	' target drop
Execute borisAddTrigger(0,5,"Trigger37","bsPit",Nothing)	' kicker
Execute borisAddTrigger(24,3,"Trigger38",Nothing,Nothing)	' slingshot
Execute borisAddTrigger(25,3,"Trigger41",Nothing,Nothing)	' slingshot
Execute borisAddTrigger(26,1,"Trigger42",Nothing,Nothing)	' trigger
Execute borisAddTrigger(27,1,"Trigger43",Nothing,Nothing)	' trigger
Execute borisAddTrigger(28,1,"Trigger44",Nothing,Nothing)	' trigger
Execute borisAddTrigger(30,6,"Trigger46",Nothing,Nothing)	' spinner
Execute borisAddTrigger(31,2,"Trigger47",Nothing,Nothing)	' trigger
Execute borisAddTrigger(32,2,"Trigger48",Nothing,Nothing)	' trigger
Execute borisAddTrigger(33,2,"Trigger51",Nothing,Nothing)	' trigger
Execute borisAddTrigger(34,1,"Trigger52",Nothing,Nothing)	' trigger
Execute borisAddTrigger(35,1,"Trigger53",Nothing,Nothing)	' trigger
Execute borisAddTrigger(36,3,"Trigger54",Nothing,Nothing)	' slingshot
Execute borisAddTrigger(37,2,"Trigger55",Nothing,Nothing)	' trigger
Execute borisAddTrigger(38,2,"Trigger56",Nothing,Nothing)	' trigger
Execute borisAddTrigger(39,2,"Trigger57",Nothing,Nothing)	' trigger
Execute borisAddTrigger(0,4,"Trigger61","btCenterTarget",1)	' target drop
Execute borisAddTrigger(0,4,"Trigger62","btCenterTarget",2)	' target drop
Execute borisAddTrigger(0,4,"Trigger63","btCenterTarget",3)	' target drop
'------------------------------------------------
' init the table
Dim bsTrough,bsPit,bsSaucer		' for kickers
Dim btUpperTarget,btCenterTarget	' for drop targets
Sub gorgar_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(Trigger55,Trigger56,Trigger57,Trigger24,Trigger25,Trigger28,Trigger31,Trigger38,Trigger41,Trigger54)
	' balls in starting lane
	Set bsTrough = New cvpmBallStack
        bsTrough.BallImage= "shinyball"
	bsTrough.InitSw 0,9,0,0,0,0,0,0
	bsTrough.InitKick Trigger21,160,1
	bsTrough.Balls = 1
	' ball in pit
	Set bsPit= New cvpmBallStack
        bsPit.BallImage= "shinyball"
	bsPit.InitSaucer Trigger37,23,160,2
	' ball in saucer
	Set bsSaucer= New cvpmBallStack
        bsSaucer.BallImage= "shinyball"
	bsSaucer.InitSaucer Trigger27,15,75,9
	' Upper drop target
	Set btUpperTarget = New cvpmDropTarget
	btUpperTarget.InitDrop Array(Trigger32,Trigger33,Trigger34),Array(18,19,20)
	btUpperTarget.AnyUpSw=20
	btUpperTarget.AllDownSw=21
	' Center drop target
	Set btCenterTarget = New cvpmDropTarget
	btCenterTarget.InitDrop Array(Trigger61,Trigger62,Trigger63),Array(41,42,43)
	btCenterTarget.AnyUpSw=40
	btCenterTarget.AllDownSw=44
End Sub
'------------------------------------------------
' keyboard : nothing special
Sub gorgar_KeyUp(ByVal keycode)
	If vpmKeyUp(keycode) Then Exit Sub
	If keycode = PlungerKey Then Plunger.Fire
       
End Sub
Sub gorgar_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
