Untitled

Option Explicit
Randomize

On Error Resume Next
ExecuteGlobal GetTextFile("controller.vbs")
If Err Then MsgBox "You need the controller.vbs in order to run this table, available in the vp10 package"
On Error Goto 0

Const cGameName="bonebstr",UseSolenoids=1,UseLamps=0,UseGI=0,SSolenoidOn="SolOn",SSolenoidOff="SolOff", SCoin="coin"

LoadVPM"01520000","sys80.VBS",1.2

Dim DesktopMode: DesktopMode = Table1.ShowDT
If DesktopMode = True Then 'Show Desktop components
Ramp16.visible=1
Ramp15.visible=1
Primitive13.visible=1
Else
Ramp16.visible=0
Ramp15.visible=0
Primitive13.visible=0
End if

'*************************************************************
'Solenoid Call backs
'**********************************************************************************************************
SolCallback(1)=  "Solenoid1"
SolCallback(2)=  "Solenoid2"
SolCallback(3)=  "Solenoid3"
SolCallback(5)=  "Solenoid5"
'SolCallback(4)=  "Solenoid4" 'Lightbox Insert Light Show
SolCallback(6)=  "Solenoid6"
'SolCallback(7)=  "Solenoid7" 'Lightbox Insert Light Show
SolCallback(8)=  "vpmSolSound SoundFX(""Knocker"",DOFKnocker),"
SolCallback(9)="bsTrough.SolIn"

SolCallback(sLRFlipper) = "SolRFlipper"
SolCallback(sLLFlipper) = "SolLFlipper"

Sub SolLFlipper(Enabled)
     If Enabled Then
         PlaySound SoundFX("fx_Flipperup",DOFContactors):LeftFlipper.RotateToEnd:LeftFlipper1.RotateToEnd
     Else
         PlaySound SoundFX("fx_Flipperdown",DOFContactors):LeftFlipper.RotateToStart:LeftFlipper1.RotateToStart
     End If
  End Sub

Sub SolRFlipper(Enabled)
     If Enabled Then
         PlaySound SoundFX("fx_Flipperup",DOFContactors):RightFlipper.RotateToEnd:RightFlipper1.RotateToEnd
     Else
         PlaySound SoundFX("fx_Flipperdown",DOFContactors):RightFlipper.RotateToStart:RightFlipper1.RotateToStart
     End If
End Sub
'**********************************************************************************************************

'Solenoid Controlled toys
'**********************************************************************************************************

Sub solTrough(Enabled) 'controlled by light ID 2
	If Enabled Then
		bsTrough.ExitSol_On
	End If
 End Sub


Sub Solenoid1(Enabled)
	If Controller.Lamp(13) Then 'S Relay enable
		SetLamp 101,Enabled 'X2 Red Domes
	Else
		bsRight.ExitSol_On
	End If
End Sub

Sub Solenoid2(Enabled)
	If Controller.Lamp(13) Then 'S Relay enable
		SetLamp 102,Enabled 'X2 Right PF flashers
	Else
		bsCenter.ExitSol_On
	End If
End Sub

Sub Solenoid3(Enabled)
	If Controller.Lamp(13) Then 'S Relay enable
		'bsKickback.ExitSol_On 'NOT WORKING Manual is Wrong!!!!!!!!!!!!!!!!!!!!
		SetLamp 103,Enabled 'X2 Top Left Flipper
	Else
		SetLamp 133,Enabled 'X2 Skull Topper ????????
	End If
End Sub

Sub Solenoid4(Enabled)
	If Controller.Lamp(13) Then 'S Relay enable
		'Q2
	Else
		   'Q 55
	End If
End Sub

Sub Solenoid5(Enabled)
	If Controller.Lamp(13) Then 'S Relay enable
		SetLamp 105,Enabled
		Else
		if Controller.switch (46) then 'UpKicker
			playsound SoundFX("Popper",DOFContactors)
			TopVUK.DestroyBall
			Set raiseball = TopVUK.CreateBall
			raiseballsw = True
			TopVukraiseballtimer.Enabled = True
			TopVUK.Enabled=TRUE
			Controller.switch (46) = False
		end if
	End If
End Sub

Sub Solenoid6(Enabled)
	If Controller.Lamp(13) Then 'S Relay enable
		SetLamp 106,Enabled
	Else
		dtLow.DropSol_On '5 bank Reset
	End If
End Sub


Sub Solenoid7(Enabled)
	If Controller.Lamp(13) Then 'S Relay enable
		 'Q1
	Else
		 'Q56
	End If
End Sub

Sub solkickback(Enabled) ' Lower Left kick back is Light ID 12 controlled
     If Enabled Then
		 bsKickback.ExitSol_On
     Else

     End If
End Sub

Sub DivL(Enabled) 'Light ID 16 controlled
     If Enabled Then
         PlaySound SoundFX("fx_Flipperup",DOFContactors):LeftGate.RotateToEnd:
		' bsKickback.ExitSol_On 'KickBack HACK when SOL 3 did not work
     Else
         LeftGate.RotateToStart
     End If
End Sub


Sub DivR(Enabled) 'Light ID 17 controlled
     If Enabled Then
         PlaySound SoundFX("fx_Flipperup",DOFContactors):RightGate.RotateToEnd:
     Else
         :RightGate.RotateToStart
     End If
End Sub


Sub RelT(Enabled)	'Playfield GI
	If Enabled Then
		dim xx
		For each xx in GI:xx.State = 0: Next
        PlaySound "fx_relay"
	Else
		For each xx in GI:xx.State = 1: Next
        PlaySound "fx_relay"
	End If
End Sub

Sub RelA(Enabled)'Playfield Relay A
	If Enabled Then
		AuxLampTimer.Enabled = 0
		AuxLampTimer1.Enabled = 1

	Else
		AuxLampTimer.Enabled = 1
		AuxLampTimer1.Enabled = 0

	End If
End Sub

Dim AuxRampLamps
Dim AuxLampCount
Sub AuxLampTimer_Timer
	AuxLampCount = (AuxLampCount + 1) Mod 6

	Select Case AuxLampCount
		Case 0:
			SetLamp 115, 1 : SetLamp 116, 0 : SetLamp 117, 0 : SetLamp 118, 0 : SetLamp 119, 0 : SetLamp 120, 0
		Case 1:
			SetLamp 115, 0 : SetLamp 116, 1 : SetLamp 117, 0 : SetLamp 118, 0 : SetLamp 119, 0 : SetLamp 120, 0
		Case 2:
			SetLamp 115, 0 : SetLamp 116, 0 : SetLamp 117, 1 : SetLamp 118, 0 : SetLamp 119, 0 : SetLamp 120, 0
		Case 3:
			SetLamp 115, 0 : SetLamp 116, 0 : SetLamp 117, 0 : SetLamp 118, 1 : SetLamp 119, 0 : SetLamp 120, 0
		Case 4:
			SetLamp 115, 0 : SetLamp 116, 0 : SetLamp 117, 0 : SetLamp 118, 0 : SetLamp 119, 1 : SetLamp 120, 0
		Case 5:
			SetLamp 115, 0 : SetLamp 116, 0 : SetLamp 117, 0 : SetLamp 118, 0 : SetLamp 119, 0 : SetLamp 120, 1
	End Select
End Sub

Dim AuxRamp1Lamps
Dim AuxLamp1Count
Sub AuxLampTimer1_Timer
	AuxLamp1Count = (AuxLamp1Count + 1) Mod 5

	Select Case AuxLamp1Count
		Case 0:
			SetLamp 111, 1: SetLamp 112, 0: SetLamp 113, 0 : SetLamp 114, 0
		Case 1:
			SetLamp 111, 0: SetLamp 112, 1: SetLamp 113, 0 : SetLamp 114, 0
		Case 3:
			SetLamp 111, 0: SetLamp 112, 0: SetLamp 113, 1 : SetLamp 114, 0
		Case 4:
			SetLamp 111, 0: SetLamp 112, 0: SetLamp 113, 0 : SetLamp 114, 1
	End Select
End Sub

Sub RelB(Enabled)'BackGlass Relay B
	If Enabled Then


	Else


	End If
End Sub

'**********************************************************************************************************

'Initiate Table
'**********************************************************************************************************

Dim bsTrough, bsCenter, bsRight, bsKickback, dtLow

Sub Table1_Init
	vpmInit Me
	On Error Resume Next
		With Controller
		.GameName = cGameName
		If Err Then MsgBox "Can't start Game" & cGameName & vbNewLine & Err.Description : Exit Sub
		.SplashInfoLine = "BoneBusters - Gottlieb"&chr(13)&"You Suck"
		.HandleMechanics=0
		.HandleKeyboard=0
		.ShowDMDOnly=1
		.ShowFrame=0
		.ShowTitle=0
        .hidden = 1
         On Error Resume Next
         .Run GetPlayerHWnd
         If Err Then MsgBox Err.Description
         On Error Goto 0
     End With
     On Error Goto 0

	PinMAMETimer.Interval=PinMAMEInterval:
	PinMAMETimer.Enabled=1
	vpmNudge.TiltSwitch=57
	vpmNudge.Sensitivity=2
	vpmNudge.TiltObj=Array(Bumper1)

	Set bsTrough=New cvpmBallStack
		bsTrough.InitSw 56,0,0,55,0,0,0,0
		bsTrough.initkick ballrelease,75,5
		bsTrough.InitExitSnd SoundFX("ballrelease",DOFContactors), SoundFX("Solenoid",DOFContactors)
		bsTrough.Balls=3

	Set bsCenter=New cvpmBallStack
		bsCenter.InitSaucer sw26,26,180,5
		bsCenter.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)

	Set bsRight=New cvpmBallStack
		bsRight.InitSaucer sw36,36,180,5
		bsRight.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)

	Set bsKickback=New cvpmBallStack
		bsKickback.InitSaucer sw42,42,0,30
		bsKickback.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)

	Set dtLow=New cvpmDropTarget
		dtLow.InitDrop Array(sw00,sw10,sw20,sw30,sw40),Array(0,10,20,30,40)
		dtLow.InitSnd SoundFX("DTDrop",DOFContactors),SoundFX("DTReset",DOFContactors)

	bsTrough.addball 0

	captiveball.CreateBall
	captiveball.Kick 0,1

End Sub

'**********************************************************************************************************
'Plunger code
'**********************************************************************************************************

Sub Table1_KeyDown(ByVal KeyCode)
	If keycode = PlungerKey Then Plunger.Pullback:playsound"plungerpull"

	If KeyCode=LeftMagnaSave Then Controller.Switch(6)=1
	If KeyCode=RightMagnaSave Then Controller.Switch(16)=1
	If KeyCode=LeftFlipperKey Then
		Controller.Switch(53)=1
	End If
	If KeyCode=RightFlipperKey Then
		Controller.Switch(35)=1
		Controller.Switch(45)=1
	End If

	If KeyDownHandler(keycode) Then Exit Sub
End Sub

Sub Table1_KeyUp(ByVal KeyCode)
	If keycode = PlungerKey Then Plunger.Fire:PlaySound"plunger"

	If KeyCode=LeftMagnaSave Then Controller.Switch(6)=0
	If KeyCode=RightMagnaSave Then Controller.Switch(16)=0
	If KeyCode=LeftFlipperKey Then
		Controller.Switch(53)=0
	End If
	If KeyCode=RightFlipperKey Then
		Controller.Switch(35)=0
		Controller.Switch(45)=0
	End If

	If KeyUpHandler(keycode) Then Exit Sub
End Sub

'**********************************************************************************************************

 ' Drain hole and kickers
Sub Drain_Hit:bsTrough.addball me : playsound"drain" : End Sub
Sub sw26_Hit:bsCenter.AddBall 0 : playsound "popper_ball": End Sub
Sub sw36_Hit:bsRight.AddBall 0 : playsound "popper_ball": End Sub
Sub sw42_Hit:bsKickback.AddBall 0 : playsound "popper_ball": End Sub

 '***********************************
 'Top right Raising VUK
 '***********************************
 Dim raiseballsw, raiseball

 Sub TopVUK_Hit()
 	TopVUK.Enabled=FALSE
	Controller.switch (46) = True
	playsound "popper_ball"
 End Sub

 Sub TopVukraiseballtimer_Timer()
 	If raiseballsw = True then
 		raiseball.z = raiseball.z + 10
 		If raiseball.z > 140 then
 			TopVUK.Kick 180, 10
 			Set raiseball = Nothing
 			TopVukraiseballtimer.Enabled = False
 			raiseballsw = False
 		End If
 	End If
 End Sub

'Drop Targets
Sub sw00_Hit:dtLow.Hit 1:End Sub
Sub sw10_Hit:dtLow.Hit 2:End Sub
Sub sw20_Hit:dtLow.Hit 3:End Sub
Sub sw30_Hit:dtLow.Hit 4:End Sub
Sub sw40_Hit:dtLow.Hit 5:End Sub

'Stand Up Target
Sub sw1_Hit:vpmTimer.PulseSw 1:End Sub
Sub sw11_Hit:vpmTimer.PulseSw 11:End Sub
Sub sw21_Hit:vpmTimer.PulseSw 21:End Sub
Sub sw31_Hit:vpmTimer.PulseSw 31:End Sub
Sub sw41_Hit:vpmTimer.PulseSw 41:End Sub
Sub sw51_Hit:vpmTimer.PulseSw 51:End Sub

Sub sw22_Hit:vpmTimer.PulseSw 22:End Sub
Sub sw23_Hit:vpmTimer.PulseSw 23:End Sub

'Star Triggers
Sub sw2_Hit:Controller.Switch(2)=1:End Sub
Sub sw2_Unhit:Controller.Switch(2)=0:End Sub
Sub sw3_Hit:Controller.Switch(3)=1:End Sub
Sub sw3_Unhit:Controller.Switch(3)=0:End Sub
Sub sw32_Hit:Controller.Switch(32)=1:End Sub
Sub sw32_Unhit:Controller.Switch(32)=0:End Sub
Sub sw33_Hit:Controller.Switch(33)=1:End Sub
Sub sw33_unHit:Controller.Switch(33)=0:End Sub

'Wire Triggers
Sub sw12_Hit:Controller.Switch(12)=1:End Sub
Sub sw12_Unhit:Controller.Switch(12)=0:End Sub
Sub sw13_Hit:Controller.Switch(13)=1:End Sub
Sub sw13_Unhit:Controller.Switch(13)=0:End Sub
Sub sw15_Hit:Controller.Switch(15)=1:End Sub
Sub sw15_Unhit:Controller.Switch(15)=0:End Sub
Sub sw34_Hit:Controller.Switch(34)=1:End Sub
Sub sw34_Unhit:Controller.Switch(34)=0:End Sub
Sub sw43_Hit:Controller.Switch(43)=1:End Sub
Sub sw43_Unhit:Controller.Switch(43)=0:End Sub

'Spinners
Sub sw14_Spin:vpmTimer.PulseSw 14 : playsound"fx_spinner" : End Sub
Sub sw24_Spin:vpmTimer.PulseSw 24 : playsound"fx_spinner" : End Sub

'Ramp Triggers
Sub sw4_Hit:Controller.Switch(4)=1:PlaySound "Wire Ramp":End Sub
Sub sw4_Unhit:Controller.Switch(4)=0:End Sub
Sub sw5_Hit:Controller.Switch(5)=1:PlaySound "Wire Ramp":End Sub
Sub sw5_Unhit:Controller.Switch(5)=0:End Sub

'Upper PF wire Trigger
Sub sw25_Hit:Controller.Switch(25)=1:End Sub
Sub sw25_Unhit:Controller.Switch(25)=0:End Sub

 'Scoring Rubber
Sub sw50_hit:vpmTimer.pulseSw 50 : playsound"flip_hit_3" : End Sub

'Gate Trigger
Sub sw44_Hit:vpmTimer.PulseSw 41:End Sub

'Bumpers
Sub Bumper1_Hit : vpmTimer.PulseSw(52) : playsound SoundFX("fx_bumper1",DOFContactors): End Sub


'Generic Sounds
Sub Trigger1_Hit:PlaySound "fx_ballrampdrop":End Sub
Sub Trigger2_Hit:PlaySound "fx_ballrampdrop":StopSound "Wire Ramp":End Sub
Sub Trigger3_Hit:PlaySound "fx_ballrampdrop":StopSound "Wire Ramp":End Sub
Sub Trigger4_Hit:PlaySound "fx_ballrampdrop":End Sub

Sub Trigger5_Hit:PlaySound "Wire Ramp":End Sub

Sub Trigger6_Hit:StopSound "Wire Ramp":PlaySound "flip_hit_3":End Sub

'***************************************************
'       JP's VP10 Fading Lamps & Flashers
'       Based on PD's Fading Light System
' SetLamp 0 is Off
' SetLamp 1 is On
' fading for non opacity objects is 4 steps
'***************************************************

Dim LampState(200), FadingLevel(200)
Dim FlashSpeedUp(200), FlashSpeedDown(200), FlashMin(200), FlashMax(200), FlashLevel(200)

InitLamps()             ' turn off the lights and flashers and reset them to the default parameters
LampTimer.Interval = 5 'lamp fading speed
LampTimer.Enabled = 1

' Lamp & Flasher Timers

Sub LampTimer_Timer()
    Dim chgLamp, num, chg, ii
    chgLamp = Controller.ChangedLamps
    If Not IsEmpty(chgLamp) Then
        For ii = 0 To UBound(chgLamp)
            LampState(chgLamp(ii, 0) ) = chgLamp(ii, 1)       'keep the real state in an array
            FadingLevel(chgLamp(ii, 0) ) = chgLamp(ii, 1) + 4 'actual fading step

	   'Special Handling
	   'If chgLamp(ii,0) = 0 Then RelQ chgLamp(ii,1) 'Game Overr Q Relay
	   If chgLamp(ii,0) = 1 Then RelT chgLamp(ii,1) 'Tilt T Relay
	   If chgLamp(ii,0) = 2 Then solTrough chgLamp(ii,1) 'Ballrelease
	   If chgLamp(ii,0) = 12 Then solkickback chgLamp(ii,1) 'kickback
	   'If chgLamp(ii,0) = 13 Then RelS chgLamp(ii,1) 'Switching S Relay
	   If chgLamp(ii,0) = 14 Then RelA chgLamp(ii,1) 'Playboard Aux Lamp A Relay
	   'If chgLamp(ii,0) = 15 Then RelB chgLamp(ii,1) 'Lightbox Aux Lamp B Relay
	   If chgLamp(ii,0) = 16 Then DivL chgLamp(ii,1) 'Left Ball Gate
	   If chgLamp(ii,0) = 17 Then DivR chgLamp(ii,1) 'Right Ball Gate
	   'If chgLamp(ii,0) = 18 Then RelC chgLamp(ii,1) 'Skull Motor C Relay
	   'If chgLamp(ii,0) = 19 Then Topper chgLamp(ii,1) ' Skull Jaw Relay
        Next
    End If
    UpdateLamps
End Sub


Sub UpdateLamps()
'NFadeL 0, L0
'NFadeL 1, L1

NFadeL 3, L3

NFadeL 5, L5
NFadeL 6, L6
NFadeL 7, L7
NFadeL 8, L8
NFadeL 9, L9
NFadeL 10, L10
NFadeL 11, L11


'NFadeL 14, l14


NFadeL 20, L20
NFadeLm 21, L21
NFadeL 21, L21a
NFadeLm 22, L22
NFadeL 22, L22a
NFadeL 23, L23
NFadeL 24, L24
NFadeL 25, L25
NFadeL 26, L26
NFadeL 27, L27
NFadeL 28, L28
NFadeLm 29, L29
NFadeLm 29, L29a
NFadeLm 30, L30
NFadeL 31, L31
NFadeL 32, L32
NFadeL 33, L33
NFadeL 34, L34
NFadeL 35, L35
NFadeL 36, L36
NFadeL 37, L37
NFadeL 38, L38
NFadeL 39, L39
NFadeL 40, L40
NFadeL 41, L41
NFadeL 42, L42
NFadeL 43, L43
NFadeL 44, L44
NFadeL 45, L45
NFadeL 46, L46
NFadeL 47, L47
NFadeLm 49, L49
NFadeL 49, L49a
NFadeL 50, L50
NFadeL 51, L51

'Solenoid + S Relay Controlled Flasheers

NFadeObjm 101, P101a, "TopRedON", "TopRed"   ' Right Dome
NFadeObjm 101, P101b, "TopRedON", "TopRed"   ' Right Dome
NFadeLm 101, s101a
NFadeLm 101, s101b
NFadeLm 101, s101c
NFadeL 101, s101d

NFadeLm 102, s102a
NFadeLm 102, s102b
NFadeLm 102, s102c
NFadeL 102, s102d

NFadeLm 103, s103a
NFadeL 103, s103b

NFadeLm 105, s105a
NFadeLm 105, s105b
NFadeLm 105, s105c
NFadeL 105, s105d

NFadeLm 106, s106a
NFadeLm 106, s106b
NFadeLm 106, s106c
NFadeL 106, s106d


'Aux Board

NFadeL 111, z1
NFadeL 112, z2
NFadeL 113, z3
NFadeL 114, z4

NFadeL 115, z5
NFadeL 116, z6
NFadeL 117, z7
NFadeL 118, z8
NFadeL 119, z9
NFadeL 120, z10

End Sub


' div lamp subs

Sub InitLamps()
    Dim x
    For x = 0 to 200
        LampState(x) = 0        ' current light state, independent of the fading level. 0 is off and 1 is on
        FadingLevel(x) = 4      ' used to track the fading state
        FlashSpeedUp(x) = 0.4   ' faster speed when turning on the flasher
        FlashSpeedDown(x) = 0.2 ' slower speed when turning off the flasher
        FlashMax(x) = 1         ' the maximum value when on, usually 1
        FlashMin(x) = 0         ' the minimum value when off, usually 0
        FlashLevel(x) = 0       ' the intensity of the flashers, usually from 0 to 1
    Next
End Sub

Sub AllLampsOff
    Dim x
    For x = 0 to 200
        SetLamp x, 0
    Next
End Sub

Sub SetLamp(nr, value)
    If value <> LampState(nr) Then
        LampState(nr) = abs(value)
        FadingLevel(nr) = abs(value) + 4
    End If
End Sub

' Lights: used for VP10 standard lights, the fading is handled by VP itself

Sub NFadeL(nr, object)
    Select Case FadingLevel(nr)
        Case 4:object.state = 0:FadingLevel(nr) = 0
        Case 5:object.state = 1:FadingLevel(nr) = 1
    End Select
End Sub

Sub NFadeLm(nr, object) ' used for multiple lights
    Select Case FadingLevel(nr)
        Case 4:object.state = 0
        Case 5:object.state = 1
    End Select
End Sub

'Lights, Ramps & Primitives used as 4 step fading lights
'a,b,c,d are the images used from on to off

Sub FadeObj(nr, object, a, b, c, d)
    Select Case FadingLevel(nr)
        Case 4:object.image = b:FadingLevel(nr) = 6                   'fading to off...
        Case 5:object.image = a:FadingLevel(nr) = 1                   'ON
        Case 6, 7, 8:FadingLevel(nr) = FadingLevel(nr) + 1             'wait
        Case 9:object.image = c:FadingLevel(nr) = FadingLevel(nr) + 1 'fading...
        Case 10, 11, 12:FadingLevel(nr) = FadingLevel(nr) + 1         'wait
        Case 13:object.image = d:FadingLevel(nr) = 0                  'Off
    End Select
End Sub

Sub FadeObjm(nr, object, a, b, c, d)
    Select Case FadingLevel(nr)
        Case 4:object.image = b
        Case 5:object.image = a
        Case 9:object.image = c
        Case 13:object.image = d
    End Select
End Sub

Sub NFadeObj(nr, object, a, b)
    Select Case FadingLevel(nr)
        Case 4:object.image = b:FadingLevel(nr) = 0 'off
        Case 5:object.image = a:FadingLevel(nr) = 1 'on
    End Select
End Sub

Sub NFadeObjm(nr, object, a, b)
    Select Case FadingLevel(nr)
        Case 4:object.image = b
        Case 5:object.image = a
    End Select
End Sub

' Flasher objects

Sub Flash(nr, object)
    Select Case FadingLevel(nr)
        Case 4 'off
            FlashLevel(nr) = FlashLevel(nr) - FlashSpeedDown(nr)
            If FlashLevel(nr) < FlashMin(nr) Then
                FlashLevel(nr) = FlashMin(nr)
                FadingLevel(nr) = 0 'completely off
            End if
            Object.IntensityScale = FlashLevel(nr)
        Case 5 ' on
            FlashLevel(nr) = FlashLevel(nr) + FlashSpeedUp(nr)
            If FlashLevel(nr) > FlashMax(nr) Then
                FlashLevel(nr) = FlashMax(nr)
                FadingLevel(nr) = 1 'completely on
            End if
            Object.IntensityScale = FlashLevel(nr)
    End Select
End Sub

Sub Flashm(nr, object) 'multiple flashers, it just sets the flashlevel
    Object.IntensityScale = FlashLevel(nr)
End Sub


'**********************************************************************************************************
'Digital Display
'**********************************************************************************************************
 Dim Digits(40)
 Digits(0)=Array(a00, a05, a0c, a0d, a08, a01, a06, a0f, a02, a03, a04, a07, a0b, a0a, a09, a0e)
 Digits(1)=Array(a10, a15, a1c, a1d, a18, a11, a16, a1f, a12, a13, a14, a17, a1b, a1a, a19, a1e)
 Digits(2)=Array(a20, a25, a2c, a2d, a28, a21, a26, a2f, a22, a23, a24, a27, a2b, a2a, a29, a2e)
 Digits(3)=Array(a30, a35, a3c, a3d, a38, a31, a36, a3f, a32, a33, a34, a37, a3b, a3a, a39, a3e)
 Digits(4)=Array(a40, a45, a4c, a4d, a48, a41, a46, a4f, a42, a43, a44, a47, a4b, a4a, a49, a4e)
 Digits(5)=Array(a50, a55, a5c, a5d, a58, a51, a56, a5f, a52, a53, a54, a57, a5b, a5a, a59, a5e)
 Digits(6)=Array(a60, a65, a6c, a6d, a68, a61, a66, a6f, a62, a63, a64, a67, a6b, a6a, a69, a6e)
 Digits(7)=Array(a70, a75, a7c, a7d, a78, a71, a76, a7f, a72, a73, a74, a77, a7b, a7a, a79, a7e)
 Digits(8)=Array(a80, a85, a8c, a8d, a88, a81, a86, a8f, a82, a83, a84, a87, a8b, a8a, a89, a8e)
 Digits(9)=Array(a90, a95, a9c, a9d, a98, a91, a96, a9f, a92, a93, a94, a97, a9b, a9a, a99, a9e)
 Digits(10)=Array(aa0, aa5, aac, aad, aa8, aa1, aa6, aaf, aa2, aa3, aa4, aa7, aab, aaa, aa9, aae)
 Digits(11)=Array(ab0, ab5, abc, abd, ab8, ab1, ab6, abf, ab2, ab3, ab4, ab7, abb, aba, ab9, abe)
 Digits(12)=Array(ac0, ac5, acc, acd, ac8, ac1, ac6, acf, ac2, ac3, ac4, ac7, acb, aca, ac9, ace)
 Digits(13)=Array(ad0, ad5, adc, add, ad8, ad1, ad6, adf, ad2, ad3, ad4, ad7, adb, ada, ad9, ade)
 Digits(14)=Array(ae0, ae5, aec, aed, ae8, ae1, ae6, aef, ae2, ae3, ae4, ae7, aeb, aea, ae9, aee)
 Digits(15)=Array(af0, af5, afc, afd, af8, af1, af6, aff, af2, af3, af4, af7, afb, afa, af9, afe)
 Digits(16)=Array(b00, b05, b0c, b0d, b08, b01, b06, b0f, b02, b03, b04, b07, b0b, b0a, b09, b0e)
 Digits(17)=Array(b10, b15, b1c, b1d, b18, b11, b16, b1f, b12, b13, b14, b17, b1b, b1a, b19, b1e)
 Digits(18)=Array(b20, b25, b2c, b2d, b28, b21, b26, b2f, b22, b23, b24, b27, b2b, b2a, b29, b2e)
 Digits(19)=Array(b30, b35, b3c, b3d, b38, b31, b36, b3f, b32, b33, b34, b37, b3b, b3a, b39, b3e)

 Digits(20)=Array(b40, b45, b4c, b4d, b48, b41, b46, b4f, b42, b43, b44, b47, b4b, b4a, b49, b4e)
 Digits(21)=Array(b50, b55, b5c, b5d, b58, b51, b56, b5f, b52, b53, b54, b57, b5b, b5a, b59, b5e)
 Digits(22)=Array(b60, b65, b6c, b6d, b68, b61, b66, b6f, b62, b63, b64, b67, b6b, b6a, b69, b6e)
 Digits(23)=Array(b70, b75, b7c, b7d, b78, b71, b76, b7f, b72, b73, b74, b77, b7b, b7a, b79, b7e)
 Digits(24)=Array(b80, b85, b8c, b8d, b88, b81, b86, b8f, b82, b83, b84, b87, b8b, b8a, b89, b8e)
 Digits(25)=Array(b90, b95, b9c, b9d, b98, b91, b96, b9f, b92, b93, b94, b97, b9b, b9a, b99, b9e)
 Digits(26)=Array(ba0, ba5, bac, bad, ba8, ba1, ba6, baf, ba2, ba3, ba4, ba7, bab, baa, ba9, bae)
 Digits(27)=Array(bb0, bb5, bbc, bbd, bb8, bb1, bb6, bbf, bb2, bb3, bb4, bb7, bbb, bba, bb9, bbe)
 Digits(28)=Array(bc0, bc5, bcc, bcd, bc8, bc1, bc6, bcf, bc2, bc3, bc4, bc7, bcb, bca, bc9, bce)
 Digits(29)=Array(bd0, bd5, bdc, bdd, bd8, bd1, bd6, bdf, bd2, bd3, bd4, bd7, bdb, bda, bd9, bde)
 Digits(30)=Array(be0, be5, bec, bed, be8, be1, be6, bef, be2, be3, be4, be7, beb, bea, be9, bee)
 Digits(31)=Array(bf0, bf5, bfc, bfd, bf8, bf1, bf6, bff, bf2, bf3, bf4, bf7, bfb, bfa, bf9, bfe)
 Digits(32)=Array(ac18, ac16, acc1, acd1, ac19, ac17, ac15, acf1, ac11, ac13, ac12, ac14, acb1, aca1, ac10, ace1)
 Digits(33)=Array(ad18, ad16, adc1, add1, ad19, ad17, ad15, adf1, ad11, ad13, ad12, ad14, adb1, ada1, ad10, ade1)
 Digits(34)=Array(ae18, ae16, aec1, aed1, ae19, ae17, ae15, aef1, ae11, ae13, ae12, ae14, aeb1, aea1, ae10, aee1)
 Digits(35)=Array(af18, af16, afc1, afd1, af19, af17, af15, aff1, af11, af13, af12, af14, afb1, afa1, af10, afe1)
 Digits(36)=Array(b9, b7, b0c1, b0d1, b100, b8, b6, b0f1, b2, b4, b3, b5, b0b1, b0a1, b1,b0e1)
 Digits(37)=Array(b109, b107, b1c1, b1d1, b110, b108, b106, b1f1, b102, b104, b103, b105, b1b1, b1a1, b101,b1e1)
 Digits(38)=Array(b119, b117, b2c1, b2d1, b120, b118, b116, b2f1, b112, b114, b113, b115, b2b1, b2a1, b111, b2e1)
 Digits(39)=Array(b129, b127, b3c1, b3d1, b130, b128, b126, b3f1, b122, b3b1, b123, b125, b3b1, b3a1, b121, b3e1)


 Sub DisplayTimer_Timer
    Dim ChgLED, ii, jj, num, chg, stat, obj, b, x
    ChgLED=Controller.ChangedLEDs(&Hffffffff, &Hffffffff)
    If Not IsEmpty(ChgLED)Then
		If DesktopMode = True Then
       For ii=0 To UBound(chgLED)
          num=chgLED(ii, 0) : chg=chgLED(ii, 1) : stat=chgLED(ii, 2)
			if (num < 40) then
              For Each obj In Digits(num)
                   If chg And 1 Then obj.State=stat And 1
                   chg=chg\2 : stat=stat\2
                  Next
			Else
			       end if
        Next
	   end if
    End If
 End Sub

'**********************************************************************************************************
'**********************************************************************************************************

'Gottlieb Bone Busters
'added by Inkochnito
Sub editDips
 	Dim vpmDips:Set vpmDips=New cvpmDips
 	With vpmDips
 		.AddForm  700,400,"Bone Busters - DIP switches"
 		.AddFrame 2,4,190,"Maximum credits",49152,Array("8 credits",0,"10 credits",32768,"15 credits",&H00004000,"20 credits",49152)'dip 15&16
 		.AddFrame 2,80,190,"Coin chute 1 and 2 control",&H00002000,Array("seperate",0,"same",&H00002000)'dip 14
 		.AddFrame 2,126,190,"Playfield special",&H00200000,Array("replay",0,"extra ball",&H00200000)'dip 22
 		.AddFrame 2,172,190,"High games to date control",&H00000020,Array("no effect",0,"reset high games 2-5 on power off",&H00000020)'dip 6
 		.AddFrame 2,218,190,"Auto-percentage control",&H00000080,Array("disabled (normal high score mode)",0,"enabled",&H00000080)'dip 8
 		.AddFrame 2,264,190,"Extra ball && special timing",&H40000000,Array("shorter",0,"longer",&H40000000)'dip 31
 		.AddChk 2,316,150,Array("Bonus ball feature",&H80000000)'dip 32
 		.AddFrame 205,4,190,"High game to date awards",&H00C00000,Array("not displayed and no award",0,"displayed and no award",&H00800000,"displayed and 2 replays",&H00400000,"displayed and 3 replays",&H00C00000)'dip 23&24
 		.AddFrame 205,80,190,"Balls per game",&H01000000,Array("5 balls",0,"3 balls",&H01000000)'dip 25
 		.AddFrame 205,126,190,"Replay limit",&H04000000,Array("no limit",0,"one per game",&H04000000)'dip 27
 		.AddFrame 205,172,190,"Novelty",&H08000000,Array("normal",0,"extra ball and replay scores 500K",&H08000000)'dip 28
 		.AddFrame 205,218,190,"Game mode",&H10000000,Array("replay",0,"extra ball",&H10000000)'dip 29
 		.AddFrame 205,264,190,"3rd coin chute credits control",&H20000000,Array("no effect",0,"add 9",&H20000000)'dip 30
 		.AddChk 170,316,100,Array("Match feature",&H02000000)'dip 26
 		.AddChk 290,316,100,Array("Attract sound",&H00000040)'dip 7
 		.AddLabel 50,340,300,20,"After hitting OK, press F3 to reset game with new settings."
 		.ViewDips
 	End With
End Sub
Set vpmShowDips=GetRef("EditDips")


'*********************************************************************
'                 Positional Sound Playback Functions
'*********************************************************************

' Play a sound, depending on the X,Y position of the table element (especially cool for surround speaker setups, otherwise stereo panning only)
' parameters (defaults): loopcount (1), volume (1), randompitch (0), pitch (0), useexisting (0), restart (1))
' Note that this will not work (currently) for walls/slingshots as these do not feature a simple, single X,Y position
Sub PlayXYSound(soundname, tableobj, loopcount, volume, randompitch, pitch, useexisting, restart)
	PlaySound soundname, loopcount, volume, AudioPan(tableobj), randompitch, pitch, useexisting, restart, AudioFade(tableobj)
End Sub

' Similar subroutines that are less complicated to use (e.g. simply use standard parameters for the PlaySound call)
Sub PlaySoundAt(soundname, tableobj)
    PlaySound soundname, 1, 1, AudioPan(tableobj), 0,0,0, 1, AudioFade(tableobj)
End Sub

Sub PlaySoundAtBall(soundname)
    PlaySoundAt soundname, ActiveBall
End Sub


'*********************************************************************
'                     Supporting Ball & Sound Functions
'*********************************************************************

Function AudioFade(tableobj) ' Fades between front and back of the table (for surround systems or 2x2 speakers, etc), depending on the Y position on the table. "table1" is the name of the table
	Dim tmp
    tmp = tableobj.y * 2 / table1.height-1
    If tmp > 0 Then
		AudioFade = Csng(tmp ^10)
    Else
        AudioFade = Csng(-((- tmp) ^10) )
    End If
End Function

Function AudioPan(tableobj) ' Calculates the pan for a tableobj based on the X position on the table. "table1" is the name of the table
    Dim tmp
    tmp = tableobj.x * 2 / table1.width-1
    If tmp > 0 Then
        AudioPan = Csng(tmp ^10)
    Else
        AudioPan = Csng(-((- tmp) ^10) )
    End If
End Function

Function Vol(ball) ' Calculates the Volume of the sound based on the ball speed
    Vol = Csng(BallVel(ball) ^2 / 2000)
End Function

Function Pitch(ball) ' Calculates the pitch of the sound based on the ball speed
    Pitch = BallVel(ball) * 20
End Function

Function BallVel(ball) 'Calculates the ball speed
    BallVel = INT(SQR((ball.VelX ^2) + (ball.VelY ^2) ) )
End Function


'*****************************************
'      JP's VP10 Rolling Sounds
'*****************************************

Const tnob = 5 ' total number of balls
ReDim rolling(tnob)
InitRolling

Sub InitRolling
    Dim i
    For i = 0 to tnob
        rolling(i) = False
    Next
End Sub

Sub RollingTimer_Timer()
    Dim BOT, b
    BOT = GetBalls

	' stop the sound of deleted balls
    For b = UBound(BOT) + 1 to tnob
        rolling(b) = False
        StopSound("fx_ballrolling" & b)
    Next

	' exit the sub if no balls on the table
    If UBound(BOT) = -1 Then Exit Sub

	' play the rolling sound for each ball
    For b = 0 to UBound(BOT)
        If BallVel(BOT(b) ) > 1 AND BOT(b).z < 30 Then
            rolling(b) = True
            PlaySound("fx_ballrolling" & b), -1, Vol(BOT(b)), AudioPan(BOT(b)), 0, Pitch(BOT(b)), 1, 0, AudioFade(BOT(b))
        Else
            If rolling(b) = True Then
                StopSound("fx_ballrolling" & b)
                rolling(b) = False
            End If
        End If
    Next
End Sub

'**********************
' Ball Collision Sound
'**********************

Sub OnBallBallCollision(ball1, ball2, velocity)
	PlaySound("fx_collide"), 0, Csng(velocity) ^2 / 2000, AudioPan(ball1), 0, Pitch(ball1), 0, 0, AudioFade(ball1)
End Sub


'*****************************************
'	ninuzzu's	FLIPPER SHADOWS
'*****************************************

sub FlipperTimer_Timer()
	FlipperLSh.RotZ = LeftFlipper.currentangle
	FlipperRSh.RotZ = RightFlipper.currentangle
	FlipperLSh1.RotZ = LeftFlipper1.currentangle

	GFL.Roty = LeftFlipper.currentangle + 240
	GFR.Roty = RightFlipper.currentangle + 120
	GFL1.Roty = LeftFlipper1.currentangle + 210
	GFR1.Roty = RightFlipper1.currentangle + 20

	primdiv1.RotZ = LeftGate.currentangle
	primdiv2.RotZ = RightGate.currentangle
End Sub

'*****************************************
'	ninuzzu's	BALL SHADOW
'*****************************************
Dim BallShadow
BallShadow = Array (BallShadow1,BallShadow2,BallShadow3,BallShadow4,BallShadow5)

Sub BallShadowUpdate_timer()
    Dim BOT, b
    BOT = GetBalls
    ' hide shadow of deleted balls
    If UBound(BOT)<(tnob-1) Then
        For b = (UBound(BOT) + 1) to (tnob-1)
            BallShadow(b).visible = 0
        Next
    End If
    ' exit the Sub if no balls on the table
    If UBound(BOT) = -1 Then Exit Sub
    ' render the shadow for each ball
    For b = 0 to UBound(BOT)
        If BOT(b).X < Table1.Width/2 Then
            BallShadow(b).X = ((BOT(b).X) - (Ballsize/6) + ((BOT(b).X - (Table1.Width/2))/7)) + 6
        Else
            BallShadow(b).X = ((BOT(b).X) + (Ballsize/6) + ((BOT(b).X - (Table1.Width/2))/7)) - 6
        End If
        ballShadow(b).Y = BOT(b).Y + 12
        If BOT(b).Z > 20 Then
            BallShadow(b).visible = 1
        Else
            BallShadow(b).visible = 0
        End If
    Next
End Sub


'************************************
' What you need to add to your table
'************************************

' a timer called RollingTimer. With a fast interval, like 10
' one collision sound, in this script is called fx_collide
' as many sound files as max number of balls, with names ending with 0, 1, 2, 3, etc
' for ex. as used in this script: fx_ballrolling0, fx_ballrolling1, fx_ballrolling2, fx_ballrolling3, etc


'******************************************
' Explanation of the rolling sound routine
'******************************************

' sounds are played based on the ball speed and position

' the routine checks first for deleted balls and stops the rolling sound.

' The For loop goes through all the balls on the table and checks for the ball speed and
' if the ball is on the table (height lower than 30) then then it plays the sound
' otherwise the sound is stopped, like when the ball has stopped or is on a ramp or flying.

' The sound is played using the VOL, AUDIOPAN, AUDIOFADE and PITCH functions, so the volume and pitch of the sound
' will change according to the ball speed, and the AUDIOPAN & AUDIOFADE functions will change the stereo position
' according to the position of the ball on the table.


'**************************************
' Explanation of the collision routine
'**************************************

' The collision is built in VP.
' You only need to add a Sub OnBallBallCollision(ball1, ball2, velocity) and when two balls collide they
' will call this routine. What you add in the sub is up to you. As an example is a simple Playsound with volume and paning
' depending of the speed of the collision.


Sub Pins_Hit (idx)
	PlaySound "pinhit_low", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall)
End Sub

Sub Targets_Hit (idx)
	PlaySound "target", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall)
End Sub

Sub Metals_Thin_Hit (idx)
	PlaySound "metalhit_thin", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
End Sub

Sub Metals_Medium_Hit (idx)
	PlaySound "metalhit_medium", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
End Sub

Sub Metals2_Hit (idx)
	PlaySound "metalhit2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
End Sub

Sub Gates_Hit (idx)
	PlaySound "gate4", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
End Sub

Sub Spinner_Spin
	PlaySound "fx_spinner", 0, .25, AudioPan(Spinner), 0.25, 0, 0, 1, AudioFade(Spinner)
End Sub

Sub Rubbers_Hit(idx)
 	dim finalspeed
  	finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
 	If finalspeed > 20 then
		PlaySound "fx_rubber2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
	End if
	If finalspeed >= 6 AND finalspeed <= 20 then
 		RandomSoundRubber()
 	End If
End Sub

Sub Posts_Hit(idx)
 	dim finalspeed
  	finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
 	If finalspeed > 16 then
		PlaySound "fx_rubber2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
	End if
	If finalspeed >= 6 AND finalspeed <= 16 then
 		RandomSoundRubber()
 	End If
End Sub

Sub RandomSoundRubber()
	Select Case Int(Rnd*3)+1
		Case 1 : PlaySound "rubber_hit_1", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
		Case 2 : PlaySound "rubber_hit_2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
		Case 3 : PlaySound "rubber_hit_3", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
	End Select
End Sub

Sub LeftFlipper_Collide(parm)
 	RandomSoundFlipper()
End Sub

Sub RightFlipper_Collide(parm)
 	RandomSoundFlipper()
End Sub

Sub RandomSoundFlipper()
	Select Case Int(Rnd*3)+1
		Case 1 : PlaySound "flip_hit_1", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
		Case 2 : PlaySound "flip_hit_2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
		Case 3 : PlaySound "flip_hit_3", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
	End Select
End Sub