112 replies to this topic

[kiwi]

Thanks for the update.
I just wanted to mention that Decidetto had found the problem of light.
Too bad I can not test the table , I downloaded a corrupt file , and I finished the daily downloads.
Strange , 1 download today and 2 yesterday.

Max

Edit : 2 download today and 3 yesterday , not strange , right.

I would start testing your hard drive - run check disk on it because I had a similar problem on a data drive this past week and it turned out that the hard drive was failing. I was not surprised after I checked the label and discovered it was manufactured June 2006 so I got a lot of mileage out of it.

Best Regards,
Todd.

My HD is not new, I bought used.
Honestly, sometimes I have problem to downloading only in this site.

Max

Edited by kiwi, 22 September 2012 - 12:37 PM.

[jimmyfingers]

Update 1.2
- fixed l1 lights and solenoid sounds (thanks kiwi)
- a few new graphics (playfield, transparent ramps ++)
- new script, ball collision, and plunger

I want to thanks thewool for sending a new playfield for the table, but I ended up fixing my old playfield because when I resized the playfield and made it darker it wasn't too different than the old one. But what I did is to use the image of Elvira and fixed some lights. So, thewool, you work wasn't for nothing

These updates of my older VP9 tables are mostly to add higher resolution playfield images, and changing them from JPG to PNG to remove artifacts added by the JPG compression.
I also add my plunger made with alpha ramps, with the script ready for the motion plunger. And I also add the collision sub with the changes by destruk for the vpm tables, which makes it quite easy to add those collision sounds to vpm tables without changing the state of kickers.

JP Thank you very much for these recent updates and adding the ball collision / tracking script. That's a great touch and helps also pave the way / save time for creating BMPR MOD versions. I'll be in touch

[oldskoolgamer]

Forgive me if this a dumb question... is it possible to make this updated release work with the B2S backglass that was released a few months back? Looks sooooo great JP!

[jimmyfingers]

Forgive me if this a dumb question... is it possible to make this updated release work with the B2S backglass that was released a few months back? Looks sooooo great JP!

There's actually a recent discussion / solution for how to do that in the desktop version support topic thread

[oldskoolgamer]

thank you ICP gave me a great idea as well to just copy the how to on the Addams Family worked like a charm.

[thewool]

Not to hijack this topic but as I've said before i think this is the way forward to release B2Ss, just stand alone in a DIY package. They can then be bolted on to any version of the table - once you've added one you can add them all!

[htamas]

Thanks oldskoolgamer for the script - it works perfectly.

[oldskoolgamer]

Thanks oldskoolgamer for the script - it works perfectly.

Nice glad to help out!

[jimmyfingers]

The DIY should be different and much briefer than the full table script as is posted above because that is risky for changing some other functions / script that have been updated or are done differenlty in the current table for which B2S is trying to be added. I see in the posted script that it has Rosve's version of my flipper tap code but JP's new table does not and has some other flipper handling (for the bally flipper graphics mainly). If this was another section that was not as interchangeable (or even maybe desirable it could have negative consequences.

In this regard, it would be best to describe only the parts needing modification for the B2S to work and where to put it. I use a program called "Beyond Compare" that has a self-contained installation version / capability. It is a great tool to compare various types of data / files / folders. I use it w.r.t. VP for comparing two scripts as to highlight the differences (handy for reverting a FS script back to Desktop for MOD releases).

But still comparing Rosve's B2S version with JP's latest is going to highlight all differences, icluding personalizations that Rosve in the script, like the flippers, so you're going if someone can sort through the minimum requirements and then post the actual B2S related only script, that I think would be better for the concept of one table and simplified table updates as they pertain to adding B2S functionality. This isn't saying anything against Rosve's customizations just that some script and object settings may differ from the existing B2S to an updated table and without some specificness of what exactly is needed or requiring matching with table object names / properties, things could get out of sync and not operate correctly.

[Slydog43]

Yeah after applying the above script, I lost the great animated analog plunger.

[oldskoolgamer]

All that was added in that script was the bottom B2S scripting and call on lighting. Nothing was changed in terms of the plunger. But oh well.

[rosve]

All the backglass flashers are missing in the B2S modded scrip above. Try this for a DIY,

====================================================

Add this at the top of the script, right after "Option Explicit"

'B2S -----------------------------
ExecuteGlobal GetTextFile("b2s.vbs")
  ResetB2SData 0,49,0    'Initialise the b2s data area
'***********************************************************************
  ' Choose where to display the THING lights
  LaunchBackGlass "Elvira_and_the_Party_Monsters_FS_B2S", true    'True=Launch bg ,  False=Don't launch bg.
'***********************************************************************
'---------------------------------

===================================================

Search for "SolCallback(27)" and replace the lines

SolCallback(27) = "vpmflasher f27,"
SolCallback(28) = "vpmflasher f28,"

With this,

'B2S ---------------------
SolCallback(9) = "SolFlash9"
SolCallback(27) = "SolFlash27"
SolCallback(28) = "SolFlash28"
'SolCallback(27) = "vpmflasher f27,"
'SolCallback(28) = "vpmflasher f28,"
' -------------------------

==========================================

Search for " 'Flashers " And replace this,

'Flashers
Sub SolFlash13(Enabled):f13.IsDropped = abs(not Enabled):End Sub
Sub SolFlash15(Enabled):f15.IsDropped = abs(not Enabled):End Sub
Sub SolFlash16(Enabled)
If Enabled Then
punch.Image = "punch2"
Else
punch.Image = "punch"
End If
buggyR.State = ABS(buggyR.State -1)
End Sub
Sub SolFlash25(Enabled):f25.State = abs(Enabled):End Sub
Sub SolFlash26(Enabled):f26b.State = abs(Enabled):f26.IsDropped = abs(not Enabled):End Sub
Sub SolFlash29(Enabled):SetLamp 48, abs(Enabled):End Sub
Sub SolFlash30(Enabled):f30.State = abs(Enabled):f30a.IsDropped = abs(not Enabled):f30b.State = abs(Enabled):End Sub
Sub SolFlash31(Enabled):f31.State = abs(Enabled):f31a.IsDropped = abs(not Enabled):f31b.State = abs(Enabled):End Sub
Sub SolFlash32(Enabled):f32.IsDropped = abs(not Enabled):End Sub

With this,

'B2S ------------------------------
'Flashers
Sub SolFlash9(Enabled):SetB2SData 7,Abs(Enabled):End Sub
Sub SolFlash13(Enabled):f13.IsDropped = abs(not Enabled):SetB2SData 8,Abs(Enabled):End Sub
Sub SolFlash15(Enabled):f15.IsDropped = abs(not Enabled):SetB2SData 9,Abs(Enabled):End Sub
Sub SolFlash16(Enabled)
If Enabled Then
punch.Image = "punch2"
Else
punch.Image = "punch"
End If
buggyR.State = ABS(buggyR.State -1)
End Sub
Sub SolFlash25(Enabled):f25.State = abs(Enabled):SetB2SData 0,Abs(Enabled):End Sub
Sub SolFlash26(Enabled):f26b.State = abs(Enabled):f26.IsDropped = abs(not Enabled):End Sub
Sub SolFlash27(Enabled):f27.State = abs(Enabled):SetB2SData 1,Abs(Enabled):End Sub
Sub SolFlash28(Enabled):f28.State = abs(Enabled):SetB2SData 2,Abs(Enabled):End Sub
Sub SolFlash29(Enabled):SetLamp 48, abs(Enabled):SetB2SData 3,Abs(Enabled):End Sub
Sub SolFlash30(Enabled):f30.State = abs(Enabled):f30a.IsDropped = abs(not Enabled):f30b.State = abs(Enabled):SetB2SData 4,Abs(Enabled):End Sub
Sub SolFlash31(Enabled):f31.State = abs(Enabled):f31a.IsDropped = abs(not Enabled):f31b.State = abs(Enabled):SetB2SData 5,Abs(Enabled):End Sub
Sub SolFlash32(Enabled):f32.IsDropped = abs(not Enabled):SetB2SData 6,Abs(Enabled):End Sub
'---------------------------------------------

================================================

Search for "UpdateLamps" and add this at the first line,

	  'B2S -------------------------
	  SendLights
	  ' ----------------------------

=================================================

Add this code to the end of the script,

'B2S -------------------
'***********************************************************************************************
'*****************************************  B2S ************************************************
'***********************************************************************************************

Sub SendLights()
   B2SUpdateLed
   Select Case LampState(60)
	  Case 4:SetB2SData 10, 0
	  Case 5:SetB2SData 10, 1
   End Select
   Select Case LampState(61)
	  Case 4:SetB2SData 11, 0
	  Case 5:SetB2SData 11, 1
   End Select
   Select Case LampState(62)
	  Case 4:SetB2SData 12, 0
	  Case 5:SetB2SData 12, 1
   End Select
   Select Case LampState(63)
	  Case 4:SetB2SData 13, 0
	  Case 5:SetB2SData 13, 1
   End Select
   Select Case LampState(64)
	  Case 4:SetB2SData 14, 0
	  Case 5:SetB2SData 14, 1
   End Select
End Sub
'***********************************************************************************************
'*****************************************  B2S ************************************************
'***********************************************************************************************

For the future, all the B2S calls are found by searching for " 'b2s "

[OuchTilt]

First I'd like to thank JP for the updated table......

Thanks for posting the script changes roger, but the lights on the BBQ are not working when you collect the BBQ Bonus

Have I missed something?

Thanks again

[rosve]

Did you add SendLights at the top of the UpdateLamps sub?

Edited by rosve, 23 September 2012 - 09:59 AM.

[OuchTilt]

Did you add SendLights at the top of the UpdateLamps sub?

I did.....
I thought it would be easier to post the script so you can find the error, thanks for your time


'Elvira and The Party Monsters
'VP9 table by JPSalas version 1.0

Option Explicit
'B2S -----------------------------
ExecuteGlobal GetTextFile("b2s.vbs")
ResetB2SData 0,49,0 'Initialise the b2s data area
'***********************************************************************
' Choose where to display the THING lights
LaunchBackGlass "Elvira_and_the_Party_Monsters_FS_B2S", true 'True=Launch bg , False=Don't launch bg.
'***********************************************************************
'---------------------------------
Randomize

LoadVPM "01560000", "S11.VBS", 3.26

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 "Can't Load VPinMAME." & vbNewLine & Err.Description
If VPMver> "" Then If Controller.Version <VPMver Or Err Then MsgBox "VPinMAME ver " & VPMver & " required."
If VPinMAMEDriverVer <VBSver Or Err Then MsgBox VBSFile & " ver " & VBSver & " or higher required."
On Error Goto 0
End Sub

Dim bsTrough, bsTP, bsBP, dtBank, bsLock, BallInVuk, x, xx
Dim bump1, bump2, bump3
Dim bumpLamp1, bumpLamp2, bumpLamp3

Const cGameName = "eatpm_l4" 'World
' Const cGameName="eatpm_4u" 'Europa
' Const cGameName="eatpm_4g" 'German

Const UseSolenoids = 1
Const UseLamps = 0
Const UseGI = 0
Const UseSync = 0
Const HandleMech = 0

' Standard Sounds
Const SSolenoidOn = "Solenoid"
Const SSolenoidOff = ""
Const SFlipperOn = "FlipperUp"
Const SFlipperOff = "FlipperDown"
Const SCoin = "Coin"

'************
' Table init.
'************

Sub Elvira_Init
vpmInit me
With Controller
.GameName = cGameName
If Err Then MsgBox "Can't start Game" & cGameName & vbNewLine & Err.Description:Exit Sub
.SplashInfoLine = "Elvira and the Party Monsters - Williams 1989" & vbNewLine & "VP9 table by JPSalas 1.0"
.HandleKeyboard = 0
.ShowTitle = 0
.ShowDMDOnly = 1
.ShowFrame = 0
.HandleMechanics = 0
.Hidden = 0
.Games(cGameName).Settings.Value("rol")=1 '1 means rotated
'.SetDisplayPosition 0,0,GetPlayerHWnd 'uncomment if you can't see the dmd
On Error Resume Next
.Run GetPlayerHWnd
If Err Then MsgBox Err.Description
On Error Goto 0
End With

' Nudging
vpmNudge.TiltSwitch = swTilt
vpmNudge.Sensitivity = 3
vpmNudge.TiltObj = Array(Bumper1, Bumper2, Bumper3, LeftSlingshot, RightSlingshot)

' Trough
Set bsTrough = New cvpmBallStack
With bsTrough
.InitSw 9, 11, 12, 13, 0, 0, 0, 0
.InitKick BallRelease, 80, 6
.InitEntrySnd "Solenoid", "Solenoid"
.InitExitSnd "ballrel", "Solenoid"
.Balls = 3
End With

' Lock
Set bsLock = new cvpmBallStack
With bsLock
.InitSw 0, 49, 50, 51, 0, 0, 0, 0
.InitKick BallLock, 80, 28
.InitAddSnd "metalrolling2"
.InitExitSnd "popper", "Solenoid"
End With

' Top Eject Hole
Set bsTP = New cvpmBallStack
With bsTP
.InitSaucer sw48, 48, 24, 14
.InitExitSnd "popper", "Solenoid"
.KickAngleVar = 3
.KickForceVar = 4
End With

' Ball Popper - VUK
Set bsBP = New cvpmBallStack
bsBP.InitSaucer sw32, 32, 0, 0
bsBP.InitKick sw32a, 190, 6
bsBP.InitExitSnd "Popper", "Solenoid"

' Drop targets
set dtbank = new cvpmdroptarget
With dtbank
.initdrop array(sw41, sw42, sw43), array(41, 42, 43)
.initsnd "droptarget", "resetdrop"
End With

' Main Timer init
PinMAMETimer.Interval = PinMAMEInterval
PinMAMETimer.Enabled = 1
'StartShake
BallInVuk = 0

' Init Bumper Rings and targets
LeftSLing.IsDropped = 1:LeftSLing2.IsDropped = 1:LeftSLing3.IsDropped = 1
RightSLing.IsDropped = 1:RightSLing2.IsDropped = 1:RightSLing3.IsDropped = 1
B1s1.IsDropped = 0:B1s1t.IsDropped = 0:B1s1on.IsDropped = 1:B1s1ton.IsDropped = 1
B1s2on.IsDropped = 1:B1s2ton.IsDropped = 1:B1s3on.IsDropped = 1:B1s3ton.IsDropped = 1
B2s1.IsDropped = 0:B2s1t.IsDropped = 0:B2s1on.IsDropped = 1:B2s1ton.IsDropped = 1
B2s2on.IsDropped = 1:B2s2ton.IsDropped = 1:B2s3on.IsDropped = 1:B2s3ton.IsDropped = 1
B3s1.IsDropped = 0:B3s1t.IsDropped = 0:B3s1on.IsDropped = 1:B3s1ton.IsDropped = 1
B3s2on.IsDropped = 1:B3s2ton.IsDropped = 1:B3s3on.IsDropped = 1:B3s3ton.IsDropped = 1
bump1 = 0:bump2 = 0:bump3 = 0
AllLampsOff
sw15a.IsDropped = 1:sw16a.IsDropped = 1
sw25a.IsDropped = 1:sw26a.IsDropped = 1:sw27a.IsDropped = 1:sw28a.IsDropped = 1
SolGI 0
SolFlash13 0:SolFlash15 0:SolFlash16 0:SolFlash26 0:SolFlash29 0:SolFlash30 0:SolFlash31 0:SolFlash32 0
End Sub

Sub Elvira_Paused:Controller.Pause = 1:End Sub
Sub Elvira_unPaused:Controller.Pause = 0:End Sub

sub kicker2_hit:kicker2.destroyball:end SUb
'**********
' Keys
'**********

Sub Elvira_KeyDown(ByVal Keycode)
If keycode = RightFlipperKey Then Controller.Switch(57) = 1
If keycode = LeftFlipperKey Then Controller.Switch(58) = 1
If keycode = LeftTiltKey Then LeftNudge 80, 1.8, 20:PlaySound "nudge_left"
If keycode = RightTiltKey Then RightNudge 280, 1.8, 20:PlaySound "nudge_right"
If keycode = CenterTiltKey Then CenterNudge 0, 3, 25:PlaySound "nudge_forward"
If vpmKeyDown(keycode) Then Exit Sub
If keycode = PlungerKey Then Plunger.TimerEnabled = 0:Plunger.Pullback:PNewPos = 0:PTime.Enabled = 1
If keycode = KeyRules Then Rules
End Sub

Sub Elvira_KeyUp(ByVal Keycode)
If keycode = RightFlipperKey Then Controller.Switch(57) = 0
If keycode = LeftFlipperKey Then Controller.Switch(58) = 0
If vpmKeyUp(keycode) Then Exit Sub
If keycode = PlungerKey Then
PTime.Enabled = 0:PNewPos = 0:PTime2.Enabled = 1:Plunger.Fire
If(BallinPlunger = 1) then 'the ball is in the plunger lane
PlaySound "Plunger2"
else
PlaySound "Plunger"
end if
End If
End Sub

'********************************
' JP's Alpha Ramp Plunger
'********************************

Dim PNewPos, POldPos
Dim Plungers:Plungers = Array(p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12, p12)
Dim BallinPlunger
InitARPlunger

Sub InitARPlunger
Dim i
For i = 1 to 11
Plungers(i).alpha = 0
Next
PRefresh.State= ABS(PRefresh.state -1)
PNewPos = 0:POldPos = 0
BallinPlunger = 0
End Sub

Sub swPlunger_Hit:Controller.Switch(21) = 1:BallinPlunger = 1:End Sub 'in this sub you may add a switch, for example Controller.Switch(14) = 1

Sub swPlunger_UnHit:Controller.Switch(21) = 0:BallinPlunger = 0:End Sub 'in this sub you may add a switch, for example Controller.Switch(14) = 0

Sub PTime_Timer 'pull timer
Plungers(POldPos).alpha = 0
Plungers(PNewPos).alpha = 1
PRefresh.State= ABS(PRefresh.state -1)
POldPos = PNewPos
PNewPos = PNewPos + 1
If PNewPos> 11 Then Me.Enabled = 0
End Sub

Sub PTime2_Timer 'release timer
Plungers(POldPos).alpha = 0
Plungers(PNewPos).alpha = 1
PRefresh.State= ABS(PRefresh.state -1)
POldPos = PNewPos
PNewPos = PNewPos + 1
If PNewPos> 2 Then
Me.Enabled = 0
Plungers(2).alpha = 0
Plungers(0).alpha = 1
PRefresh.State= ABS(PRefresh.state -1)
End If

End Sub

'PinWizard Plunger script
'Turn on the Plunger timer if analog plunger is detected

Dim AnPlNewPos, AnPlOldPos
AnPlNewPos = 0:AnPlOldPos = 0

If Plunger.MotionDevice> 0 Then
Plunger.TimerEnabled = 1
Plunger.MechPlunger = 1
End If

Sub Plunger_Timer()
If Plunger.MotionDevice> 0 Then
Plungers(AnPlOldPos).alpha = 0
AnPlNewPos = Plunger.Position \ 2
Plungers(AnPlNewPos).alpha = 1
PRefresh.State= ABS(PRefresh.state -1)
AnPlOldPos = AnPlNewPos
End if
End Sub

'*************************************
' Nudge System
' based on Noah's nudgetest table
'*************************************

Dim LeftNudgeEffect, RightNudgeEffect, NudgeEffect

Sub LeftNudge(angle, strength, delay)
vpmNudge.DoNudge angle, (strength * (delay-LeftNudgeEffect) / delay) + RightNudgeEffect / delay
LeftNudgeEffect = delay
RightNudgeEffect = 0
RightNudgeTimer.Enabled = 0
LeftNudgeTimer.Interval = delay
LeftNudgeTimer.Enabled = 1
End Sub

Sub RightNudge(angle, strength, delay)
vpmNudge.DoNudge angle, (strength * (delay-RightNudgeEffect) / delay) + LeftNudgeEffect / delay
RightNudgeEffect = delay
LeftNudgeEffect = 0
LeftNudgeTimer.Enabled = 0
RightNudgeTimer.Interval = delay
RightNudgeTimer.Enabled = 1
End Sub

Sub CenterNudge(angle, strength, delay)
vpmNudge.DoNudge angle, strength * (delay-NudgeEffect) / delay
NudgeEffect = delay
NudgeTimer.Interval = delay
NudgeTimer.Enabled = 1
End Sub

Sub LeftNudgeTimer_Timer()
LeftNudgeEffect = LeftNudgeEffect-1
If LeftNudgeEffect = 0 then LeftNudgeTimer.Enabled = False
End Sub

Sub RightNudgeTimer_Timer()
RightNudgeEffect = RightNudgeEffect-1
If RightNudgeEffect = 0 then RightNudgeTimer.Enabled = False
End Sub

Sub NudgeTimer_Timer()
NudgeEffect = NudgeEffect-1
If NudgeEffect = 0 then NudgeTimer.Enabled = False
End Sub

'*********
' Switches
'*********

' Slings
Dim LStep, RStep

Sub LeftSlingShot_Slingshot:LeftSling.IsDropped = 0:PlaySound "slingshot":vpmTimer.PulseSw 33:LStep = 0:Me.TimerEnabled = 1:End Sub

Sub LeftSlingShot_Timer
Select Case LStep
Case 0:LeftSLing.IsDropped = 0
Case 1: 'pause
Case 2:LeftSLing.IsDropped = 1:LeftSLing2.IsDropped = 0
Case 3:LeftSLing2.IsDropped = 1:LeftSLing3.IsDropped = 0
Case 4:LeftSLing3.IsDropped = 1:Me.TimerEnabled = 0
End Select

LStep = LStep + 1
End Sub

Sub RightSlingShot_Slingshot:RightSling.IsDropped = 0:PlaySound "slingshot":vpmTimer.PulseSw 34:RStep = 0:Me.TimerEnabled = 1:End Sub
Sub RightSlingShot_Timer
Select Case RStep
Case 0:RightSLing.IsDropped = 0
Case 1: 'pause
Case 2:RightSLing.IsDropped = 1:RightSLing2.IsDropped = 0
Case 3:RightSLing2.IsDropped = 1:RightSLing3.IsDropped = 0
Case 4:RightSLing3.IsDropped = 1:Me.TimerEnabled = 0
End Select

RStep = RStep + 1
End Sub

' Bally Bumper thumpers
Sub Bumper1_Hit:vpmTimer.PulseSw 35:PlaySound "bumper1":bump1 = 1:Bumper1.TimerEnabled = 1:End Sub
Sub Bumper1_Timer():UpdateBumper1:End Sub
Sub UpdateBumper1()
Select Case bump1
Case 0
If bumpLamp1 = 0 Then
B1s1.IsDropped = 0:B1s1t.IsDropped = 0:B1s1on.IsDropped = 1:B1s1ton.IsDropped = 1
Else
B1s1on.IsDropped = 0:B1s1ton.IsDropped = 0:B1s1.IsDropped = 1:B1s1t.IsDropped = 1
End If
Case 1:B1s1.IsDropped = 1:B1s1t.IsDropped = 1:B1s1on.IsDropped = 1:B1s1ton.IsDropped = 1:B1s3on.IsDropped = 0:B1s3ton.IsDropped = 0:bump1 = 2
Case 2:B1s3on.IsDropped = 1:B1s3ton.IsDropped = 1:B1s2on.IsDropped = 0:B1s2ton.IsDropped = 0:bump1 = 3
Case 3:B1s2on.IsDropped = 1:B1s2ton.IsDropped = 1:Bumper1.TimerEnabled = 0:bump1=0:UpdateBumper1
End Select
End Sub

Sub Bumper2_Hit:vpmTimer.PulseSw 36:PlaySound "bumper2":bump2 = 1:Bumper2.TimerEnabled = 1:End Sub
Sub Bumper2_Timer():UpdateBumper2:End Sub
Sub UpdateBumper2()
Select Case bump2
Case 0
If bumpLamp2 = 0 Then
B2s1.IsDropped = 0:B2s1t.IsDropped = 0:B2s1on.IsDropped = 1:B2s1ton.IsDropped = 1
Else
B2s1on.IsDropped = 0:B2s1ton.IsDropped = 0:B2s1.IsDropped = 1:B2s1t.IsDropped = 1
End If
Case 1:B2s1.IsDropped = 1:B2s1t.IsDropped = 1:B2s1on.IsDropped = 1:B2s1ton.IsDropped = 1:B2s3on.IsDropped = 0:B2s3ton.IsDropped = 0:bump2 = 2
Case 2:B2s3on.IsDropped = 1:B2s3ton.IsDropped = 1:B2s2on.IsDropped = 0:B2s2ton.IsDropped = 0:bump2 = 3
Case 3:B2s2on.IsDropped = 1:B2s2ton.IsDropped = 1:Bumper2.TimerEnabled = 0:bump2=0:UpdateBumper2
End Select
End Sub

Sub Bumper3_Hit:vpmTimer.PulseSw 37:PlaySound "bumper3":bump3 = 1:Bumper3.TimerEnabled = 1:End Sub
Sub Bumper3_Timer():UpdateBumper3:End Sub
Sub UpdateBumper3()
Select Case bump3
Case 0
If bumpLamp3 = 0 Then
B3s1.IsDropped = 0:B3s1t.IsDropped = 0:B3s1on.IsDropped = 1:B3s1ton.IsDropped = 1
Else
B3s1on.IsDropped = 0:B3s1ton.IsDropped = 0:B3s1.IsDropped = 1:B3s1t.IsDropped = 1
End If
Case 1:B3s1.IsDropped = 1:B3s1t.IsDropped = 1:B3s1on.IsDropped = 1:B3s1ton.IsDropped = 1:B3s3on.IsDropped = 0:B3s3ton.IsDropped = 0:bump3 = 2
Case 2:B3s3on.IsDropped = 1:B3s3ton.IsDropped = 1:B3s2on.IsDropped = 0:B3s2ton.IsDropped = 0:bump3 = 3
Case 3:B3s2on.IsDropped = 1:B3s2ton.IsDropped = 1:Bumper3.TimerEnabled = 0:bump3=0:UpdateBumper3
End Select
End Sub

' Eject holes
Sub Drain_Hit:ClearBallID:Playsound "drain":bsTrough.AddBall Me:End Sub
Sub Drain1_Hit:ClearBallID:Playsound "drain":bsTrough.AddBall Me:End Sub
Sub Drain2_Hit:ClearBallID:Playsound "drain":bsTrough.AddBall Me:End Sub
Sub Drain3_Hit:ClearBallID:Playsound "drain":bsTrough.AddBall Me:End Sub
Sub Drain4_Hit:ClearBallID:Playsound "drain":bsTrough.AddBall Me:End Sub
Sub sw48_Hit:PlaySound "kicker_enter":bsTP.AddBall Me:End Sub
Sub BallLock_Hit:ClearBallID:PlaySound "hole_enter":bsLock.AddBall Me:End Sub

' Rollovers
Sub sw17_Hit:la1.IsDropped = 1:Controller.Switch(17) = 1:PlaySound "sensor":End Sub
Sub sw17_UnHit:la1.IsDropped = 0:Controller.Switch(17) = 0:PlaySound"outlane":End Sub

Sub sw18_Hit:la2.IsDropped = 1:Controller.Switch(18) = 1:PlaySound "sensor":End Sub
Sub sw18_UnHit:la2.IsDropped = 0:Controller.Switch(18) = 0:End Sub

Sub sw19_Hit:la3.IsDropped = 1:Controller.Switch(19) = 1:PlaySound "sensor":End Sub
Sub sw19_UnHit:la3.IsDropped = 0:Controller.Switch(19) = 0:End Sub

Sub sw20_Hit:la4.IsDropped = 1:Controller.Switch(20) = 1:PlaySound "sensor":End Sub
Sub sw20_UnHit:la4.IsDropped = 0:Controller.Switch(20) = 0:PlaySound"outlane":End Sub

Sub sw22_Hit:Controller.Switch(22) = 1:PlaySound "sensor":End Sub
Sub sw22_UnHit:Controller.Switch(22) = 0:End Sub

Sub sw23_Hit:la5.IsDropped = 1:Controller.Switch(23) = 1:PlaySound "sensor":End Sub
Sub sw23_UnHit:la5.IsDropped = 0:Controller.Switch(23) = 0:End Sub

Sub sw29_Hit:Controller.Switch(29) = 1:PlaySound "gate":End Sub
Sub sw29_UnHit:Controller.Switch(29) = 0:End Sub

Sub sw30_Hit:Controller.Switch(30) = 1:End Sub
Sub sw30_UnHit:Controller.Switch(30) = 0:End Sub

Sub sw31_Hit:Controller.Switch(31) = 1:End Sub
Sub sw31_UnHit:Controller.Switch(31) = 0:PlaySound "metalrolling":End Sub

Sub sw32_Hit():ClearBallID:PlaySound "kicker_enter":bsBP.AddBall Me:End Sub

Sub sw44_Hit:Controller.Switch(44) = 1:End Sub
Sub sw44_UnHit:Controller.Switch(44) = 0:End Sub

Sub sw45_Hit:la6.IsDropped = 1:Controller.Switch(45) = 1:PlaySound "sensor":End Sub
Sub sw45_UnHit:la6.IsDropped = 0:Controller.Switch(45) = 0:End Sub

Sub sw46_Hit:la7.IsDropped = 1:Controller.Switch(46) = 1:PlaySound "sensor":End Sub
Sub sw46_UnHit:la7.IsDropped = 0:Controller.Switch(46) = 0:End Sub

Sub sw47_Hit:la8.IsDropped = 1:Controller.Switch(47) = 1:PlaySound "sensor":End Sub
Sub sw47_UnHit:la8.IsDropped = 0:Controller.Switch(47) = 0:End Sub

Sub sw52_Hit:Controller.Switch(52) = 1:End Sub
Sub sw52_UnHit:Controller.Switch(52) = 0:End Sub

' Targets
Sub sw15_Hit:vpmTimer.PulseSw 15:sw15.IsDropped = 1:sw15a.IsDropped = 0:Me.TimerEnabled = 1:PlaySound "target":End Sub
Sub sw16_Hit:vpmTimer.PulseSw 16:sw16.IsDropped = 1:sw16a.IsDropped = 0:Me.TimerEnabled = 1:PlaySound "target":End Sub
Sub sw25_Hit:vpmTimer.PulseSw 25:sw25.IsDropped = 1:sw25a.IsDropped = 0:Me.TimerEnabled = 1:PlaySound "target":End Sub
Sub sw26_Hit:vpmTimer.PulseSw 26:sw26.IsDropped = 1:sw26a.IsDropped = 0:Me.TimerEnabled = 1:PlaySound "target":End Sub
Sub sw27_Hit:vpmTimer.PulseSw 27:sw27.IsDropped = 1:sw27a.IsDropped = 0:Me.TimerEnabled = 1:PlaySound "target":End Sub
Sub sw28_Hit:vpmTimer.PulseSw 28:sw28.IsDropped = 1:sw28a.IsDropped = 0:Me.TimerEnabled = 1:PlaySound "target":End Sub
Sub sw15_Timer:sw15.IsDropped = 0:sw15a.IsDropped = 1:Me.TimerEnabled = 0:End Sub
Sub sw16_Timer:sw16.IsDropped = 0:sw16a.IsDropped = 1:Me.TimerEnabled = 0:End Sub
Sub sw25_Timer:sw25.IsDropped = 0:sw25a.IsDropped = 1:Me.TimerEnabled = 0:End Sub
Sub sw26_Timer:sw26.IsDropped = 0:sw26a.IsDropped = 1:Me.TimerEnabled = 0:End Sub
Sub sw27_Timer:sw27.IsDropped = 0:sw27a.IsDropped = 1:Me.TimerEnabled = 0:End Sub
Sub sw28_Timer:sw28.IsDropped = 0:sw28a.IsDropped = 1:Me.TimerEnabled = 0:End Sub

' Droptargets
Sub sw41_Hit:dtbank.Hit 1:End Sub
Sub sw42_Hit:dtbank.Hit 2:End Sub
Sub sw43_Hit:dtbank.Hit 3:End Sub

' Gates
Sub Gate1_Hit():PlaySound "gate":End Sub
Sub Gate2_Hit():PlaySound "gate":End Sub
Sub Gate3_Hit():PlaySound "gate":End Sub

' Flip Targets

Sub sw53_Hit()
PlaySound "target"
vpmTimer.PulseSw 55
Controller.Switch(53) = 1
elvira1.IsDropped = 1
End Sub

Sub sw54_Hit()
PlaySound "target"
vpmTimer.PulseSw 56
Controller.Switch(54) = 1
drac1.IsDropped = 1
End Sub

'*********
'Solenoids
'*********

SolCallback(1) = "bsTrough.SolIn"
SolCallback(2) = "bsTrough.SolOut"
SolCallback(3) = "dtbank.SolDropUp"
SolCallback(5) = "bsTP.SolOut"
SolCallback(6) = "SolPopper"
SolCallback(7) = "vpmSolSound ""knocker"","
SolCallback(8) = "bsLock.SolOut"
SolCallback(11) = "SolGI"
SolCallback(13) = "SolFlash13"
SolCallback(14) = "SolBoogie"
SolCallback(15) = "SolFlash15"
SolCallback(16) = "SolFlash16"
'SolCallback(18) = "vpmSolSound ""slingshot"","
'SolCallback(20) = "vpmSolSound ""slingshot"","
SolCallback(22) = "SolFlipReset"
SolCallback(23) = "SolRun"
SolCallback(25) = "SolFlash25"
SolCallback(26) = "SolFlash26"
'B2S ---------------------
SolCallback(9) = "SolFlash9"
SolCallback(27) = "SolFlash27"
SolCallback(28) = "SolFlash28"
'SolCallback(27) = "vpmflasher f27,"
'SolCallback(28) = "vpmflasher f28,"
' -------------------------
SolCallback(29) = "SolFlash29"
SolCallback(30) = "SolFlash30"
SolCallback(31) = "SolFlash31"
SolCallback(32) = "SolFlash32"

Sub SolBoogie(Enabled)
If Enabled then
PlaySound "solenoid"
f14.image = "boogie2"
else
f14.image = "boogie1"
End If
buggyR.State = ABS(buggyR.State -1)
End Sub

'***********************
' Special Bally Flippers
'***********************

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

Dim FlOldPos, FlNewPos, FrOldPos, FrNewPos, LF, RF
FlOldPos = 0
FlNewPos = 0
FrOldPos = 0
FrNewPos = 0

LF = Array(lf1, lf2, lf3, lf4, lf5, lf6, lf7, lf8, lf9, lf10, lf11)
RF = Array(rf1, rf2, rf3, rf4, rf5, rf6, rf7, rf8, rf9, rf10, rf11)

InitFlippers
Set MotorCallback = GetRef("UpdateFlippers")

Sub InitFlippers
Dim ii
For each ii in lf2:ii.IsDropped = 1:next
For each ii in lf3:ii.IsDropped = 1:next
For each ii in lf4:ii.IsDropped = 1:next
For each ii in lf5:ii.IsDropped = 1:next
For each ii in lf6:ii.IsDropped = 1:next
For each ii in lf7:ii.IsDropped = 1:next
For each ii in lf8:ii.IsDropped = 1:next
For each ii in lf9:ii.IsDropped = 1:next
For each ii in lf10:ii.IsDropped = 1:next
For each ii in lf11:ii.IsDropped = 1:next

For each ii in rf2:ii.IsDropped = 1:next
For each ii in rf3:ii.IsDropped = 1:next
For each ii in rf4:ii.IsDropped = 1:next
For each ii in rf5:ii.IsDropped = 1:next
For each ii in rf6:ii.IsDropped = 1:next
For each ii in rf7:ii.IsDropped = 1:next
For each ii in rf8:ii.IsDropped = 1:next
For each ii in rf9:ii.IsDropped = 1:next
For each ii in rf10:ii.IsDropped = 1:next
For each ii in rf11:ii.IsDropped = 1:next
End Sub

Sub UpdateFlippers
dim obj, a
a = rightflipper.currentangle
if a> 285 then FrNewPos = 10 else
if a <285 then FrNewPos = 9 else
if a <280 then FrNewPos = 8 else
if a <275 then FrNewPos = 7 else
if a <270 then FrNewPos = 6 else
if a <265 then FrNewPos = 5 else
if a <260 then FrNewPos = 4 else
if a <255 then FrNewPos = 3 else
if a <250 then FrNewPos = 2 else
if a <245 then FrNewPos = 1 else
if a <239 then FrNewPos = 0

If FrNewPos <> FrOldPos Then
For each obj in RF(FrOldPos):obj.IsDropped = 1:next
For each obj in RF(FrNewPos):obj.IsDropped = 0:next
FrOldPos = FrNewPos
End If

a = leftflipper.currentangle
if a> 115 then FlNewPos = 0 else
if a <115 then FlNewPos = 1 else
if a <110 then FlNewPos = 2 else
if a <105 then FlNewPos = 3 else
if a <100 then FlNewPos = 4 else
if a <95 then FlNewPos = 5 else
if a <90 then FlNewPos = 6 else
if a <85 then FlNewPos = 7 else
if a <80 then FlNewPos = 8 else
if a <75 then FlNewPos = 9 else
if a <71 then FlNewPos = 10

If FlNewPos <> FlOldPos Then
For each obj in LF(FlOldPos):obj.IsDropped = 1:next
For each obj in LF(FlNewPos):obj.IsDropped = 0:next
FlOldPos = FlNewPos
End if
End Sub

Sub SolLFlipper(Enabled)
Dim tmp
If Enabled Then
PlaySound "flipperup":LeftFlipper.RotateToEnd
Else
tmp = LeftFlipper.Strength
LeftFlipper.Strength = 6 'increase return strength to compensate for the slower speed
PlaySound "flipperdown":LeftFlipper.RotateToStart
LeftFlipper.Strength = tmp
End If
End Sub

Sub SolRFlipper(Enabled)
Dim tmp
If Enabled Then
PlaySound "flipperup":RightFlipper.RotateToEnd
Else
tmp = RightFlipper.Strength
RightFlipper.Strength = 6 'increase return strength to compensate for the slower speed
PlaySound "flipperdown":RightFlipper.RotateToStart
RightFlipper.Strength = tmp
End If
End Sub

Sub LeftFlipper_Collide(parm)
PlaySound "rubber_flipper"
End Sub

Sub RightFlipper_Collide(parm)
PlaySound "rubber_flipper"
End Sub


'****
' GI
'****

Sub SolGI(Enabled)
If Enabled Then
gi1.state = 0
gi2.state = 0
gi2b.state = 0
gi3.state = 0
gi3a.state = 0
gi3b.state = 0
gi4.state = 0
gi4a.state = 0
gi4b.state = 0
gi5.IsDropped = 1
gi6.state = 0
gi7.state = 0
gi8.state = 0
gi9.state = 0
gi10.state = 0
gi11.state = 0
gi11a.state = 0
gi11b.state = 0
gi12.IsDropped = 1
gi13.IsDropped = 1
gi14.IsDropped = 1
Else
gi1.state = 1
gi2.state = 1
gi2b.state = 1
gi3.state = 1
gi3a.state = 1
gi3b.state = 1
gi4.state = 1
gi4a.state = 1
gi4b.state = 1
gi5.IsDropped = 0
gi6.state = 1
gi7.state = 1
gi8.state = 1
gi9.state = 1
gi10.state = 1
gi11.state = 1
gi11a.state = 1
gi11b.state = 1
gi12.IsDropped = 0
gi13.IsDropped = 0
gi14.IsDropped = 0
End If
End Sub

'B2S ------------------------------
'Flashers
Sub SolFlash9(Enabled):SetB2SData 7,Abs(Enabled):End Sub
Sub SolFlash13(Enabled):f13.IsDropped = abs(not Enabled):SetB2SData 8,Abs(Enabled):End Sub
Sub SolFlash15(Enabled):f15.IsDropped = abs(not Enabled):SetB2SData 9,Abs(Enabled):End Sub
Sub SolFlash16(Enabled)
If Enabled Then
punch.Image = "punch2"
Else
punch.Image = "punch"
End If
buggyR.State = ABS(buggyR.State -1)
End Sub
Sub SolFlash25(Enabled):f25.State = abs(Enabled):SetB2SData 0,Abs(Enabled):End Sub
Sub SolFlash26(Enabled):f26b.State = abs(Enabled):f26.IsDropped = abs(not Enabled):End Sub
Sub SolFlash27(Enabled):f27.State = abs(Enabled):SetB2SData 1,Abs(Enabled):End Sub
Sub SolFlash28(Enabled):f28.State = abs(Enabled):SetB2SData 2,Abs(Enabled):End Sub
Sub SolFlash29(Enabled):SetLamp 48, abs(Enabled):SetB2SData 3,Abs(Enabled):End Sub
Sub SolFlash30(Enabled):f30.State = abs(Enabled):f30a.IsDropped = abs(not Enabled):f30b.State = abs(Enabled):SetB2SData 4,Abs(Enabled):End Sub
Sub SolFlash31(Enabled):f31.State = abs(Enabled):f31a.IsDropped = abs(not Enabled):f31b.State = abs(Enabled):SetB2SData 5,Abs(Enabled):End Sub
Sub SolFlash32(Enabled):f32.IsDropped = abs(not Enabled):SetB2SData 6,Abs(Enabled):End Sub
'---------------------------------------------
' Vertical Up-Kicker

Dim popperBall, popperZpos

Sub SolPopper(Enabled)
If Enabled Then
If bsBP.Balls Then
Set popperBall = sw32a.Createball
popperBall.Z = 0
popperZpos = 0
'PlaySound "popper"
sw32a.TimerInterval = 2
sw32a.TimerEnabled = 1
End If
End If
End Sub

Sub sw32a_Timer
popperBall.Z = popperZpos
popperZpos = popperZpos + 10
If popperZpos> 150 Then
sw32a.TimerEnabled = 0
sw32a.DestroyBall
bsBP.ExitSol_On
End If
End Sub

' Flip reset

Sub SolFlipReset(Enabled)
If Enabled Then
PlaySound "metalhit2"
elvira1.IsDropped = 0
drac1.IsDropped = 0
Controller.Switch(53) = 0
Controller.Switch(54) = 0
End If
End Sub

' Game over mode: bumpers and slingshots are turned off
Sub SolRun(enabled)
If Enabled Then
Bumper1.Force = 10
Bumper2.Force = 10
Bumper3.Force = 10
LeftSlingShot.SlingshotStrength = 8
RightSlingShot.SlingshotStrength = 8
Else
Bumper1.Force = 0
Bumper2.Force = 0
Bumper3.Force = 0
LeftSlingShot.SlingshotStrength = 0
RightSlingShot.SlingshotStrength = 0
End If
End Sub

'*****************************
' Helpers and extra sound subs
'*****************************

Sub LRampHelp_Hit():PlaySound "ballhit":ActiveBall.VelY = 1:End Sub
Sub RRampHelp_Hit():PlaySound "ballhit":ActiveBall.VelY = 1:End Sub
Sub URampHelp_Hit():ActiveBall.VelX = - 4:PlaySound "ballhit":End Sub
Sub top1_Hit():PlaySound "ballhit":End Sub
Sub Launchball_Hit()
If ActiveBall.VelY <0 Then Playsound "metalrolling2"
End Sub

'****************************************
' JP's Fading Lamps 3.5 VP9 Fading only
' Based on PD's Fading Lights
' SetLamp 0 is Off
' SetLamp 1 is On
' LampState(x) current state
'****************************************

Dim LampState(200)

'AllLampsOff()
LampTimer.Interval = 35
LampTimer.Enabled = 1

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) + 4
Next
End If

UpdateLamps
'B2S -------------------------
SendLights
' ----------------------------
End Sub

Sub UpdateLamps
FadeL 1, l1, l1a
FadeL 2, l2, l2a
FadeL 3, l3, l3a
FadeL 4, l4, l4a
FadeL 5, l5, l5a
FadeL 6, l6, l6a
FadeL 7, l7, l7a
FadeL 8, l8, l8a
FadeL 9, l9, l9a
FadeL 10, l10, l10a
NFadeLm 11, l11b
NFadeWm 11, l11a
NFadeL 11, l11
FadeL 12, l12, l12a
FadeL 13, l13, l13a
FadeL 14, l14, l14a
FadeL 15, l15, l15a
FadeL 16, l16, l16a
NFadeL 17, l17
NFadeL 18, l18
FadeL 19, l19, l19a
NFadeLm 20, l20b
NFadeWm 20, l20a
NFadeL 20, l20
FadeL 21, l21, l21a
FadeL 22, l22, l22a
FadeL 23, l23, l23a
FadeL 24, l24, l24a
NFadeL 25, l25
FadeL 26, l26, l26a
FadeL 27, l27, l27a
FadeL 28, l28, l28a
FadeL 29, l29, l29a
FadeL 30, l30, l30a
FadeL 31, l31, l31a
FadeL 32, l32, l32a
FadeL 33, l33, l33a
FadeL 34, l34, l34a
FadeL 35, l35, l35a
FadeL 36, l36, l36a
FadeL 37, l37, l37a
FadeL 38, l38, l38a
FadeL 39, l39, l39a
FadeL 40, l40, l40a
FadeL 41, l41, l41a
FadeL 42, l42, l42a
FadeL 43, l43, l43a
FadeL 44, l44, l44a
FadeL 45, l45, l45a
FadeL 46, l46, l46a
FadeL 47, l47, l47a
FadeL 48, l48, l48a
FadeL 49, l49, l49a
FadeL 50, l50, l50a
FadeL 51, l51, l51a
FadeL 52, l52, l52a
FadeL 53, l53, l53a
NFadeB1 54
NFadeB2 55
NFadeB3 56
NFadeW 57, l57
NFadeW 58, l58
NFadeW 59, l59
NFadeL 60, l60
NFadeL 61, l61
NFadeL 62, l62
NFadeL 63, l63
NFadeL 64, l64
End Sub

Sub AllLampsOff():For x = 1 to 200:LampState(x) = 4:Next:UpdateLamps:UpdateLamps:Updatelamps:End Sub

Sub SetLamp(nr, value):LampState(nr) = abs(value) + 4:End Sub

Sub FadeW(nr, a, b, c)
Select Case LampState(nr)
Case 2:c.IsDropped = 1:LampState(nr) = 0 'Off
Case 3:b.IsDropped = 1:c.IsDropped = 0:LampState(nr) = 2 'fading...
Case 4:a.IsDropped = 1:b.IsDropped = 0:LampState(nr) = 3 'fading...
Case 5:c.IsDropped = 1:a.IsDropped = 0:LampState(nr) = 1 'ON
End Select
End Sub

Sub FadeWm(nr, a, b, c)
Select Case LampState(nr)
Case 2:c.IsDropped = 1
Case 3:b.IsDropped = 1:c.IsDropped = 0
Case 4:a.IsDropped = 1:b.IsDropped = 0
Case 5:c.IsDropped = 1:a.IsDropped = 0
End Select
End Sub

Sub NFadeW(nr, a)
Select Case LampState(nr)
Case 4:a.IsDropped = 1:LampState(nr) = 0
Case 5:a.IsDropped = 0:LampState(nr) = 1
End Select
End Sub

Sub NFadeWm(nr, a)
Select Case LampState(nr)
Case 4:a.IsDropped = 1
Case 5:a.IsDropped = 0
End Select
End Sub

Sub NFadeWi(nr, a)
Select Case LampState(nr)
Case 5:a.IsDropped = 1:LampState(nr) = 0
Case 4:a.IsDropped = 0:LampState(nr) = 1
End Select
End Sub

Sub FadeL(nr, a, b)
Select Case LampState(nr)
Case 2:b.state = 0:LampState(nr) = 0
Case 3:b.state = 1:LampState(nr) = 2
Case 4:a.state = 0:LampState(nr) = 3
Case 5:a.state = 1:LampState(nr) = 1
End Select
End Sub

Sub FadeLm(nr, a, b)
Select Case LampState(nr)
Case 2:b.state = 0
Case 3:b.state = 1
Case 4:a.state = 0
Case 5:a.state = 1
End Select
End Sub

Sub NFadeL(nr, a)
Select Case LampState(nr)
Case 4:a.state = 0:LampState(nr) = 0
Case 5:a.State = 1:LampState(nr) = 1
End Select
End Sub

Sub NFadeLm(nr, a)
Select Case LampState(nr)
Case 4:a.state = 0
Case 5:a.State = 1
End Select
End Sub

Sub FadeR(nr, a)
Select Case LampState(nr)
Case 2:a.SetValue 3:LampState(nr) = 0
Case 3:a.SetValue 2:LampState(nr) = 2
Case 4:a.SetValue 1:LampState(nr) = 3
Case 5:a.SetValue 0:LampState(nr) = 1
End Select
End Sub

Sub FadeRm(nr, a)
Select Case LampState(nr)
Case 2:a.SetValue 3
Case 3:a.SetValue 2
Case 4:a.SetValue 1
Case 5:a.SetValue 0
End Select
End Sub

Sub NFadeT(nr, a, b)
Select Case LampState(nr)
Case 4:a.Text = "":LampState(nr) = 0
Case 5:a.Text = b:LampState(nr) = 1
End Select
End Sub

Sub NFadeTm(nr, a, b)
Select Case LampState(nr)
Case 4:a.Text = ""
Case 5:a.Text = b
End Select
End Sub

Sub NFadeWi(nr, a)
Select Case LampState(nr)
Case 4:a.IsDropped = 0:LampState(nr) = 0
Case 5:a.IsDropped = 1:LampState(nr) = 1
End Select
End Sub

Sub NFadeWim(nr, a)
Select Case LampState(nr)
Case 4:a.IsDropped = 0
Case 5:a.IsDropped = 1
End Select
End Sub

Sub FadeLCo(nr, a, b) 'fading collection of lights
Dim obj
Select Case LampState(nr)
Case 2:vpmSolToggleObj b, Nothing, 0, 0:LampState(nr) = 0
Case 3:vpmSolToggleObj b, Nothing, 0, 1:LampState(nr) = 2
Case 4:vpmSolToggleObj a, Nothing, 0, 0:LampState(nr) = 3
Case 5:vpmSolToggleObj a, Nothing, 0, 1:LampState(nr) = 1
End Select
End Sub

Sub FlashL(nr, a, b) ' simple light flash, not controlled by the rom
Select Case LampState(nr)
Case 2:b.state = 0:LampState(nr) = 0
Case 3:b.state = 1:LampState(nr) = 2
Case 4:a.state = 0:LampState(nr) = 3
Case 5:a.state = 1:LampState(nr) = 4
End Select
End Sub

Sub MFadeL(nr, a, b, c) 'Light acting as a flash. C is the light number to be restored
Select Case LampState(nr)
Case 2:b.state = 0:LampState(nr) = 0: If LampState© = 1 Then SetLamp c, 1
Case 3:b.state = 1:LampState(nr) = 2
Case 4:a.state = 0:LampState(nr) = 3
Case 5:a.state = 1:LampState(nr) = 1
End Select
End Sub

Sub NFadeB1(nr) 'New Bally Bumper Thumpers: only sets a variable
Select Case LampState(nr)
Case 4:bumpLamp1=0:UpdateBumper1:LampState(nr) = 0
Case 5:bumpLamp1=1:UpdateBumper1:LampState(nr) = 1
End Select
End Sub

Sub NFadeB2(nr) 'New Bally Bumper Thumpers: only sets a variable
Select Case LampState(nr)
Case 4:bumpLamp2=0:UpdateBumper2:LampState(nr) = 0
Case 5:bumpLamp2=1:UpdateBumper2:LampState(nr) = 1
End Select
End Sub

Sub NFadeB3(nr) 'New Bally Bumper Thumpers: only sets a variable
Select Case LampState(nr)
Case 4:bumpLamp3=0:UpdateBumper3:LampState(nr) = 0
Case 5:bumpLamp3=1:UpdateBumper3:LampState(nr) = 1
End Select
End Sub

'******
' Rules
'******
Dim Msg(20)
Sub Rules()
Msg(0) = "Elvira and the Party Monsters - Williams 1989" &Chr(10) &Chr(10)
Msg(1) = ""
Msg(2) = "Eyes indicate number of balls locked. Enable locks by completing BAT Lanes or JAM"
Msg(3) = "Drop Targets. Lock balls (3 to start Multi-Ball) in Skull. During Multi-Ball, ride Monster"
Msg(4) = "Slide and Party Punch ramps for JACKPOT."
Msg(5) = ""
Msg(6) = "Light Dead Heads on backboard to spot MILLION shot on Eject Hole by shooting for"
Msg(7) = "Dead Head Targets. Light Barbeque on Eject Hole by flipping both Flip-Up Targets."
Msg(8) = ""
Msg(9) = "Vie for 3 Million Points. Light the Monster Slide to spot an ELVIRA letter by"
Msg(10) = "completing Dead Head Targets, BAT Lanes, or JAM Drop Targets. Spot letter by riding"
Msg(11) = "the Slide. Spelling ELVIRA lights Skull for 3 Million on timer."
Msg(12) = ""
Msg(13) = "Increase the Boogie Bonus with JAM Targets and Bumpers. JAM Targets"
Msg(14) = "also light Eject Hole to collect Boogie Bonus."
Msg(15) = ""
Msg(16) = "Ride Monster Slide Ramp. Ramp builds till 1 Million scored. Each shot then"
Msg(17) = "collects 250,000 points and spots an ELVIRA letter."
Msg(18) = ""
Msg(19) = "A Party Punch Ramp shot collects and advances current position value."
Msg(20) = "Scoring 250,000 points on ramp awards EXTRA BALL."
For X = 1 To 20
Msg(0) = Msg(0) + Msg(X) &Chr(13)
Next

MsgBox Msg(0), , " Instructions and Rule Card"
End Sub

'****************************************
' Based on rascal's Ball Rolling Script
'****************************************
Dim VeloY(3), VeloX(3), rolling(3), b
b = 0

Sub RollingSound() 'Called by the XYdata timer
b = b + 1
If b> 3 Then b = 1
If BallStatus(b) = 0 Then
If rolling(b) = True Then
StopSound "ballrolling" &b
rolling(b) = False
Exit Sub
Else
Exit Sub
End If
End if

VeloY(b) = Cint(CurrentBall(b).VelY)
VeloX(b) = Cint(CurrentBall(b).VelX)
If(ABS(VeloY(b) )> 3 or ABS(VeloX(b) )> 3) and CurrentBall(b).Z <55 Then 'do not sound if the ball is on a ramp
If rolling(b) = True then
Exit Sub
Else
rolling(b) = True
PlaySound "ballrolling" &b
End If
Else
If rolling(b) = True Then
StopSound "ballrolling" &b
rolling(b) = False
End If
End If
End Sub

'******************************
' destruk's new vpmCreateBall
' use it: vpmCreateBall kicker
' Use it in vpm tables instead
' of CreateBallID kickername
'******************************

Set vpmCreateBall = GetRef("mypersonalcreateballroutine")
Function mypersonalcreateballroutine(aKicker)
For cnt = 1 to ubound(ballStatus) ' Loop through all possible ball IDs
If ballStatus(cnt) = 0 Then ' If ball ID is available...
If Not IsEmpty(vpmBallImage) Then
Set currentball(cnt) = aKicker.CreateBall.Image ' Set ball object with the first available ID
Else
Set currentball(cnt) = aKicker.CreateBall
End If
Set mypersonalcreateballroutine = aKicker
currentball(cnt).uservalue = cnt ' Assign the ball's uservalue to it's new ID
ballStatus(cnt) = 1 ' Mark this ball status active
ballStatus(0) = ballStatus(0)+1 ' Increment ballStatus(0), the number of active balls
If coff = False Then ' If collision off, overrides auto-turn on collision detection
' If more than one ball active, start collision detection process
If ballStatus(0) > 1 and XYdata.enabled = False Then XYdata.enabled = True
End If
Exit For ' New ball ID assigned, exit loop
End If
Next
End Function

'****************************************
' B2B Collision by Steely & Pinball Ken
' added destruk changes
'****************************************

Dim tnopb, nosf
'
tnopb = 10
nosf = 10

Dim currentball(10), ballStatus(10)
Dim iball, cnt, coff, errMessage

XYdata.interval = 1
coff = False

For cnt = 0 to ubound(ballStatus)
ballStatus(cnt) = 0
Next

' Create ball in kicker and assign a Ball ID used mostly in non-vpm tables
Sub CreateBallID(Kickername)
For cnt = 1 to ubound(ballStatus)
If ballStatus(cnt) = 0 Then
Set currentball(cnt) = Kickername.createball
currentball(cnt).uservalue = cnt
ballStatus(cnt) = 1
ballStatus(0) = ballStatus(0) + 1
If coff = False Then
If ballStatus(0)> 1 and XYdata.enabled = False Then XYdata.enabled = True
End If
Exit For
End If
Next
End Sub

Sub ClearBallID
On Error Resume Next
iball = ActiveBall.uservalue
currentball(iball).UserValue = 0
If Err Then Msgbox Err.description & vbCrLf & iball
ballStatus(iBall) = 0
ballStatus(0) = ballStatus(0) -1
On Error Goto 0
End Sub

' Ball data collection and B2B Collision detection
ReDim baX(tnopb, 4), baY(tnopb, 4), bVx(tnopb, 4), bVy(tnopb, 4), TotalVel(tnopb, 4)
Dim cForce, bDistance, xyTime, cFactor, id, id2, id3, B1, B2

Sub XYdata_Timer()
'Call ball rolling sound
RollingSound
xyTime = Timer + (XYdata.interval * .001)
If id2 >= 4 Then id2 = 0
id2 = id2 + 1
For id = 1 to ubound(ballStatus)
If ballStatus(id) = 1 Then
baX(id, id2) = round(currentball(id).x, 2)
baY(id, id2) = round(currentball(id).y, 2)
bVx(id, id2) = round(currentball(id).velx, 2)
bVy(id, id2) = round(currentball(id).vely, 2)
TotalVel(id, id2) = (bVx(id, id2) ^2 + bVy(id, id2) ^2)
If TotalVel(id, id2)> TotalVel(0, 0) Then TotalVel(0, 0) = int(TotalVel(id, id2) )
End If
Next

id3 = id2:B2 = 2:B1 = 1
Do
If ballStatus(B1) = 1 and ballStatus(B2) = 1 Then
bDistance = int((TotalVel(B1, id3) + TotalVel(B2, id3) ) ^1.04)
If((baX(B1, id3) - baX(B2, id3) ) ^2 + (baY(B1, id3) - baY(B2, id3) ) ^2) <2800 + bDistance Then collide B1, B2:Exit Sub
End If
B1 = B1 + 1
If B1 >= ballStatus(0) Then Exit Do
If B1 >= B2 then B1 = 1:B2 = B2 + 1
Loop

If ballStatus(0) <= 1 Then XYdata.enabled = False

If XYdata.interval >= 40 Then coff = True:XYdata.enabled = False
If Timer> xyTime * 3 Then coff = True:XYdata.enabled = False
If Timer> xyTime Then XYdata.interval = XYdata.interval + 1
End Sub

'Calculate the collision force and play sound
Dim cTime, cb1, cb2, avgBallx, cAngle, bAngle1, bAngle2

Sub Collide(cb1, cb2)
If TotalVel(0, 0) / 1.8> cFactor Then cFactor = int(TotalVel(0, 0) / 1.8)
avgBallx = (bvX(cb2, 1) + bvX(cb2, 2) + bvX(cb2, 3) + bvX(cb2, 4) ) / 4
If avgBallx <bvX(cb2, id2) + .1 and avgBallx> bvX(cb2, id2) -.1 Then
If ABS(TotalVel(cb1, id2) - TotalVel(cb2, id2) ) <.000005 Then Exit Sub
End If
If Timer <cTime Then Exit Sub
cTime = Timer + .1
GetAngle baX(cb1, id3) - baX(cb2, id3), baY(cb1, id3) - baY(cb2, id3), cAngle
id3 = id3 - 1:If id3 = 0 Then id3 = 4
GetAngle bVx(cb1, id3), bVy(cb1, id3), bAngle1
GetAngle bVx(cb2, id3), bVy(cb2, id3), bAngle2
cForce = Cint((abs(TotalVel(cb1, id3) * Cos(cAngle-bAngle1) ) + abs(TotalVel(cb2, id3) * Cos(cAngle-bAngle2) ) ) )
If cForce <4 Then Exit Sub
cForce = Cint((cForce) / (cFactor / nosf) )
If cForce> nosf-1 Then cForce = nosf-1
PlaySound("collide" & cForce)
End Sub

Dim Xin, Yin, rAngle, Radit, wAngle, Pi
Pi = Round(4 * Atn(1), 6) '3.1415926535897932384626433832795

' Get angle
Sub GetAngle(Xin, Yin, wAngle)
If Sgn(Xin) = 0 Then
If Sgn(Yin) = 1 Then rAngle = 3 * Pi / 2 Else rAngle = Pi / 2
If Sgn(Yin) = 0 Then rAngle = 0
Else
rAngle = atn(- Yin / Xin)
End If
If sgn(Xin) = -1 Then Radit = Pi Else Radit = 0
If sgn(Xin) = 1 and sgn(Yin) = 1 Then Radit = 2 * Pi
wAngle = round((Radit + rAngle), 4)
End Sub

'B2S -------------------
'***********************************************************************************************
'***************************************** B2S ************************************************
'***********************************************************************************************

Sub SendLights()
B2SUpdateLed
Select Case LampState(60)
Case 4:SetB2SData 10, 0
Case 5:SetB2SData 10, 1
End Select
Select Case LampState(61)
Case 4:SetB2SData 11, 0
Case 5:SetB2SData 11, 1
End Select
Select Case LampState(62)
Case 4:SetB2SData 12, 0
Case 5:SetB2SData 12, 1
End Select
Select Case LampState(63)
Case 4:SetB2SData 13, 0
Case 5:SetB2SData 13, 1
End Select
Select Case LampState(64)
Case 4:SetB2SData 14, 0
Case 5:SetB2SData 14, 1
End Select
End Sub
'***********************************************************************************************

[rosve]

Like this,

  Sub UpdateLamps
	 'B2S -------------------------
		   SendLights
	  ' ----------------------------
	   FadeL 1, l1, l1a
	   FadeL 2, l2, l2a
	   FadeL 3, l3, l3a

[kiwi]

Some invisible things.
The Ramp 1568 should have the right and left walls visible to 0 instead of 6 and the Ramp 1566 should have the right and left walls visible to 6 instead of 0.
The Wall 588 through the plastic at the entrance of the right ramp.
On the top of the left ramp, the ball leaves the sign of the passage (the X scale is too large).
In the desktop version occasionally , the ball leaves the sign of his passage into the drain zone.

Thanks

Max

[jpsalas]

Thanks kiwi SOmething to fix for the next revision

[kiwi]

I forgot to tell you that there are transparent pixels in the 3 "JAM" target.

Thanks

Max

[OuchTilt]

Like this,

Sub UpdateLamps
	 'B2S -------------------------
		 SendLights
	 ' ----------------------------
	 FadeL 1, l1, l1a
	 FadeL 2, l2, l2a
	 FadeL 3, l3, l3a

Thanks for this, working great now