[ARCHIVÉ] Tables VPX Version 3

'************ Pinball Magic
'************
'************ unclewilly
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

'RomNames
cGameName = "pmv112"

Dim VarHidden, UseVPMDMD
Dim DNSlider

If Table1.ShowDT = true then
   UseVPMDMD = true
   VarHidden = 1
else
   UseVPMDMD = False
   VarHidden = 0
end if

DNSlider = (Table1.NightDay)

Sub LightAdjust
   Dim gg
      for each gg in GI:gg.intensity= gg.intensity-(DNSlider * .095):Next
      for each gg in GI2:gg.intensity= gg.intensity-(DNSlider * .50):Next
End Sub

'****************************
'''''Captive Ball Init
Kicker3.createball:kicker3.kick 0, 0
Kicker4.createsizedball 30

kicker4.kick 350, 10
Sub Kicker4_Hit
   ActiveBall.image = "whiteballtrans"
   Kicker4.enabled = 0
    kicker4.kick 350, 10
End Sub
Dim MBall


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

  LoadVPM "01560000", "capcom.VBS", 3.26

  Dim cGameName

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

     'Standard Sounds
     Const SSolenoidOn = "Solenoid"
     Const SSolenoidOff = ""
     Const SCoin = "coin"

     'Table Init

  Sub Table1_Init
      vpmInit Me
      With Controller
         .GameName =  cGameName
          If Err Then MsgBox "Can't start Game " & cGameName & vbNewLine & Err.Description:Exit Sub
          .SplashInfoLine = "Pinball Magic" & vbNewLine & "by unclewilly vp9"
          .HandleKeyboard = 0
          .ShowTitle = 0
          .ShowDMDOnly = 1
          .ShowFrame = 0
          .HandleMechanics = 0
          .Hidden = VarHidden
          On Error Resume Next
          .Run GetPlayerHWnd
          If Err Then MsgBox Err.Description
          On Error Goto 0
      End With

'Nudging
       vpmNudge.TiltSwitch=14
       vpmNudge.Sensitivity=1
       vpmNudge.TiltObj=Array(Bumper1b,LeftSlingshot,RightSlingshot)
 
   WandDiv.IsDropped=1:WandDiv1.IsDropped=0
   Kickback.PullBack
      '**Main Timer init
           PinMAMETimer.Enabled = 1
LightAdjust

  End Sub

   Sub Table1_Paused:Controller.Pause = 1:End Sub
   Sub Table1_unPaused:Controller.Pause = 0:End Sub
   Sub Table1_Exit:Controller.Stop:End Sub


'*****Keys
 Sub Table1_KeyDown(ByVal keycode)

     If keycode = plungerkey then plunger.PullBack:PlaySound "plungerpull",0,1,0.25,0.25
    If Keycode = RightFlipperKey then SolRFlipper 1
    If Keycode = LeftFlipperKey then SolLFlipper 1
      If keycode = LeftTiltKey Then Nudge 90, 4
     If keycode = RightTiltKey Then Nudge 270, 4
     If keycode = CenterTiltKey Then Nudge 0, 5
     If vpmKeyDown(keycode) Then Exit Sub
   If keycode = 30 then TestKick.CreateBall:TestKick.Kick 180, 10:LightAdjust


End Sub

Sub Table1_KeyUp(ByVal keycode)

     If keycode = plungerkey then plunger.Fire:PlaySound "plunger",0,1,0.25,0.25
    If Keycode = RightFlipperKey then SolRFlipper 0
    If Keycode = LeftFlipperKey then SolLFlipper 0
   If vpmKeyUp(keycode) Then Exit Sub

End Sub

 'Solenoids
      SolCallback(1)="SolTrunk"
      SolCallback(2)="SolGenie"
      SolCallback(5)="SolKB"
      SolCallback(6)="SolTroughOut"
      SolCallback(7)="SolTroughIn"

      SolCallback(11)="SolStageDoors"
      SolCallback(12)="SolStageKicker"
      SolCallback(13)="SolStageDiverter"
      SolCallback(14)="SolWandDiverter"
      SolCallback(17)="SolWand"
      SolCallback(18)="SolElevator"
      SolCallback(19)="DropReset"
      SolCallback(20)="SolMag"

      SolCallback(26)="SetLamp 176,"
      SolCallback(27)="SetLamp 177,"
      SolCallback(28)="SetLamp 178,"
      SolCallback(29)="SetLamp 179,"
      SolCallback(30)="SetLamp 180,"
      SolCallback(31)="SetLamp 181,"
      SolCallback(32)="SetLamp 182,"
  '**************
  ' Solenoid Subs
  '**************
Sub SolKB(enabled)
   If enabled Then
      Kickback.Fire
   Else
      Kickback.Pullback
   end If
End Sub
'*****Trunk Lock
TrunkWall1.IsDropped = 1:TrunkWall2.IsDropped = 1
Sub SolTrunk(enabled)
   If enabled Then
      TrunkDoorP.TransY = -100
      TrunkDoor.IsDropped = 1
      TrunkDoor.TimerEnabled = 1
   Else

   End If
End Sub

Sub TrunkDoor_Timer
      TrunkDoorP.TransY = 0
      TrunkDoor.IsDropped = 0
   TrunkDoor.TimerEnabled = 0
End Sub

Sub Sw25_hit()
   Controller.Switch(25) = 1
End Sub

Sub Sw25_Unhit()
   Controller.Switch(25) = 0
End Sub

Sub Sw26_hit()
   TrunkWall2.IsDropped = 0
   Controller.Switch(26) = 1
End Sub

Sub Sw26_Unhit()
   TrunkWall2.IsDropped = 1
   Controller.Switch(26) = 0
End Sub

Sub Sw27_hit()
   TrunkWall1.IsDropped = 0
   Controller.Switch(27) = 1
End Sub

Sub Sw27_Unhit()
   TrunkWall1.IsDropped = 1
   Controller.Switch(27) = 0
End Sub
'***********Wand
Dim WandPos,WandDir
WandPos = 42:WandDir = -1
HandP.ObjRotZ = WandPos
WandP.ObjRotZ = WandPos
WandR.ObjRotZ = WandPos
Controller.Switch(67)=1:Controller.Switch(68)=0
CriticDiv.IsDropped = 1
TrunkDiv.IsDropped = 0
Sub SolWand(enabled)
If Enabled Then
   DOF 101, DOFOn
   WandT.Enabled = 1
Else
   WandT.enabled = 0
end if
End Sub

Sub WandT_Timer
   WandPos = WandPos + WandDir
   If WandPos > 42 then WandPos = 42:WandDir = -1
   If WandPos < -22 then WandPos = -22:WandDir = 1
   If WandPos >38 then
      Controller.Switch(67)=1
      CriticDiv.IsDropped = 1
      TrunkDiv.IsDropped = 0
   Else
      DOF 101, DOFOff
      Controller.Switch(67)=0
   end If
   If WandPos < -18 then
      Controller.Switch(68)=1
      CriticDiv.IsDropped = 0
      TrunkDiv.IsDropped = 1
   Else
      DOF 101, DOFOff
      Controller.Switch(68)=0
   end If
   If WandPos > -18 and wandPos < 38 Then
      CriticDiv.IsDropped = 0
      TrunkDiv.IsDropped = 0
   end If
   HandP.ObjRotZ = WandPos
   WandP.ObjRotZ = WandPos
   WandR.ObjRotZ = WandPos
End Sub
Dim xx
Sub SolMag(enabled)
   If enabled Then
      Ramp19.Collidable = False
      Wall71.TimerEnabled = 1
   Else

   End If
End Sub
Sub Wall71_Timer()
      Wall71.TimerEnabled = 0
   Ramp19.Collidable = True
End Sub
'*******End Wand

Sub SolTroughOut(enabled)
   If enabled then BallRelease.Kick 45, 25
End Sub

Sub SolTroughIn(enabled)
   If enabled then Drain.Kick 135, 2
End Sub

Sub SolStageDiverter(enabled)
   If enabled then
      StageDiverter.IsDropped = 1
   Else
      StageDiverter.IsDropped = 0
   end if
End Sub

Sub SolWandDiverter(enabled)
   If enabled then
      WandDiv.IsDropped=0:WandDiv1.IsDropped=1
      WandDiv.TimerEnabled = 0
      WandDiv.TimerEnabled = 1
   End If
End Sub

Sub WandDiv_Timer()
   WandDiv.IsDropped=1:WandDiv1.IsDropped=0
   WandDiv.TimerEnabled = 0
End Sub

Sub sw60_hit()

End Sub
Sub Stagein_Hit()
   vpmTimer.PulseSw 60
   DoorOpen
   vpmTimer.AddTimer 1000,"SKick'"
End Sub
Dim MyBall, ELActive
ElActive = 0
Sub Elevator_Hit()
   Set MyBall=ActiveBall
   Elevator.DestroyBall
   Set MyBall=Elevator.CreateBall
   vpmTimer.PulseSw 57
   DoorOpen
   ElActive = 1
End Sub

Dim LBall, EDown
Edown = 0
CreateLBall
Sub CreateLBall()
   Set LBall=LevBall.CreateBall
End Sub

Sub solElevator(enabled)
   If Enabled Then
      DOF 102, DOFOn
      EMotor.Enabled = 1
   end If
end Sub
Dim EPos
EPos = 100
Sub Emotor_Timer()
   If EDown = 0 Then
      Epos = Epos + 1
      LBall.Z = EPos
      el.z = EPos/2
      If EPos <= 300 and elactive = 1then MyBall.Z = EPos
      If EPos = 300 then :elevator.kick 90, 10: elactive = 0: DoorClose: DOF 104, DOFPulse : end if
      If Epos = 300 Then   
         DOF 102, DOFOff
         EMotor.Enabled = 0
         EDown = 1
         Controller.Switch(58)=1
      End If
      Controller.Switch(59)=0
   else
      Epos = Epos - 1
      LBall.Z = EPos
      If Epos = 100 Then   
         DOF 102, DOFOff
         EMotor.Enabled = 0
         EDown = 0
         Controller.Switch(59)=1
      End If
      Controller.Switch(58)=0
   end if   
End Sub

Sub SolStageKicker(enabled)
   If Enabled then stagein.Kick 180, 25, 90
   
End Sub

Sub SKick()
   stagein.Kick 180, 50, 80
   DOF 105, DOFPulse
   vpmTimer.AddTimer 1000,"DoorClose'"
End Sub

Controller.Switch(62)=1:Controller.Switch(59)=1:Controller.Switch(58)= 0
Dim DoorDir
DoorDir = 0
Sub SolStageDoors(enabled)
   If enabled then
      'DoorOpen
   Else
      'DoorClose'
   end if
End Sub
Dim DoorPos, DrOpn
DoorPos = 0:DrOpn = 0
Sub DoorOpen()
      'If DrOpn = 0
      DOF 103, DOFOn
      DoorDir = 1:DoorT.Timerenabled = 1
      Controller.Switch(62)=0:Controller.Switch(61)=0      
End Sub

Sub DoorT_Timer()
      DoorPos = DoorPos + DoorDir
      If DoorPos > 40 or doorPos < 0 Then DoorT.TimerEnabled = 0:DOF 103, DOFOff'Exit Sub
      If DoorPos > 40 then DoorPos = 40
      If DoorPos < 0 then DoorPos = 0
      DoorPos = DoorPos + DoorDir
      DoorL.TransX = -DoorPos:DoorR.TransX = DoorPos
End Sub
Sub DoorClose()
      DOF 103, DOFOn
      DoorDir = -1:DoorT.Timerenabled = 1
      Controller.Switch(62)=1:Controller.Switch(61)=1
End Sub
'***********************************************
'**************
 ' Flipper Subs
 '**************
 
 SolCallback(sLRFlipper) = "SolRFlipper"
 SolCallback(sLLFlipper) = "SolLFlipper"

Sub SolLFlipper(Enabled)
     If Enabled Then      
       PlaySound SoundFX("fx_Flipperup",DOFContactors), 0, .67, -0.05, 0.05
       LeftFlipper.RotateToEnd
     Else
       PlaySound SoundFX("fx_Flipperdown",DOFContactors), 0, 1, -0.05, 0.05
       LeftFlipper.RotateToStart
     End If
 End Sub

Sub SolRFlipper(Enabled)
     If Enabled Then
       PlaySound SoundFX("fx_Flipperup",DOFContactors), 0, .67, 0.05, 0.05
       RightFlipper.RotateToEnd
     Else
       PlaySound SoundFX("fx_Flipperdown",DOFContactors), 0, 1, 0.05, 0.05
       RightFlipper.RotateToStart
     End If
 End Sub


 'Kickers, drains, poppers
   '********Ball Trough
   'Init
   sw1a.IsDropped = 1:sw2a.IsDropped = 1:sw3a.IsDropped = 1:sw4a.IsDropped = 1
   Dim DrainCount
   DrainCount = 0
   Drain.TimerEnabled = 1
   Sub Drain_Timer()
      Drain.createball:Drain.Kick 135, 2
      DrainCount = DrainCount + 1
      If DrainCount = 4 then
         Drain.TimerEnabled = 0   'Drain.Enabled = 0:
      end if
   End Sub
   Sub BallRelease_Hit()
      sw1a.IsDropped = 0
      Controller.Switch(74) = 1
   End Sub
   Sub BallRelease_UnHit()
      sw1a.IsDropped = 1
      Controller.Switch(74) = 0
   End Sub

   Sub sw1_Hit()
      sw2a.IsDropped = 0
      Controller.Switch(74) = 1
   End Sub
   Sub sw1_UnHit()
      sw2a.IsDropped = 1
      Controller.Switch(74) = 0
   End Sub

   Sub sw2_Hit()
      sw3a.IsDropped = 0
      Controller.Switch(75) = 1
   End Sub
   Sub sw2_UnHit()
      sw3a.IsDropped = 1
      Controller.Switch(75) = 0
   End Sub

   Sub sw3_Hit()
      sw4a.IsDropped = 0
      Controller.Switch(76) = 1
   End Sub
   Sub sw3_UnHit()
      sw4a.IsDropped = 1
      Controller.Switch(76) = 0
   End Sub

   Sub sw4_Hit()

      Controller.Switch(73) = 1
   End Sub
   Sub sw4_UnHit()

      Controller.Switch(73) = 0
   End Sub

   Sub sw52_Hit()
      Activeball.vely = 35
      Controller.Switch(52) = 1
      
   End Sub
   Sub sw52_UnHit()
      
      Controller.Switch(52) = 0
   End Sub

   Sub swHelp_Hit()
      Activeball.vely = 25      
   End Sub

Sub TroughHelp_Hit()
   TroughHelp.Kick 90, 10
End Sub

Sub SolGenie(enabled)   'GenieTrough
   sw28.kick 321, 55
   PlaySound SoundFX("popper_ball",DOFContactors),0,1,-0.05,0.0
End Sub



'**********Sling Shot Animations
' Rstep and Lstep  are the variables that increment the animation
'****************
Dim RStep, Lstep, RStep1

Sub RightSlingShot_Slingshot
   vpmTimer.PulseSw 22
    PlaySound SoundFX("left_slingshot",DOFContactors), 0, 1, 0.05, 0.05
    RS.Visible = 0
    RS1.Visible = 1
    sling1.TransZ = -20
    RStep = 0
    RightSlingShot.TimerEnabled = 1

End Sub

Sub RightSlingShot_Timer
    Select Case RStep
        Case 3:RS1.Visible = 0:RS2.Visible = 1:sling1.TransZ = -10
        Case 4:RS2.Visible = 0:RS.Visible = 1:sling1.TransZ = 0:RightSlingShot.TimerEnabled = 0
    End Select
    RStep = RStep + 1
End Sub

Sub RightSlingShot1_Slingshot
   vpmTimer.PulseSw 46
    PlaySound SoundFX("left_slingshot",DOFContactors), 0, 1, 0.05, 0.05
    RtS.Visible = 0
    RtS1.Visible = 1
    sling3.TransZ = -20
    RStep1 = 0
    RightSlingShot1.TimerEnabled = 1

End Sub

Sub RightSlingShot1_Timer
    Select Case RStep1
        Case 3:RtS1.Visible = 0:RtS2.Visible = 1:sling3.TransZ = -10
        Case 4:RtS2.Visible = 0:RtS.Visible = 1:sling3.TransZ = 0:RightSlingShot1.TimerEnabled = 0
    End Select
    RStep1 = RStep1 + 1
End Sub

Sub LeftSlingShot_Slingshot
   vpmTimer.PulseSw 19
    PlaySound SoundFX("left_slingshot",DOFContactors),0,1,-0.05,0.05
    LS.Visible = 0
    LS1.Visible = 1
    sling2.TransZ = -20
    LStep = 0
    LeftSlingShot.TimerEnabled = 1

End Sub

Sub LeftSlingShot_Timer
    Select Case LStep
        Case 3:LS1.Visible = 0:LS2.Visible = 1:sling2.TransZ = -10
        Case 4:LS2.Visible = 0:LS.Visible = 1:sling2.TransZ = 0:LeftSlingShot.TimerEnabled = 0
    End Select
    LStep = LStep + 1
End Sub

'AutomaticUpdates
Sub UpdatesTimer_Timer()
   RollingUpdate
   
End Sub

'************Bumper1

Sub Bumper1b_Hit()
   vpmTimer.PulseSw 69
    PlaySound SoundFX("fx_bumper1",DOFContactors), 0, 1, 0.05, 0.05
End Sub

'**********Drop Targets
Sub sw41_Hit()
   Controller.Switch(41) = 1
   PlaySound SoundFX("target",DOFContactors), 0, 1, 0.05, 0.05
End Sub

Sub sw42_Hit()
   Controller.Switch(42) = 1
   PlaySound SoundFX("target",DOFContactors), 0, 1, 0.05, 0.05
End Sub

Sub sw43_Hit()
   Controller.Switch(43) = 1
   PlaySound SoundFX("target",DOFContactors), 0, 1, 0.05, 0.05
End Sub

Sub sw44_Hit()
   Controller.Switch(44) = 1
   PlaySound SoundFX("target",DOFContactors), 0, 1, 0.05, 0.05
End Sub

Sub sw45_Hit()
   Controller.Switch(45) = 1
   PlaySound SoundFX("target",DOFContactors), 0, 1, 0.05, 0.05
End Sub

Sub DropReset(enabled)
   If enabled then
      Controller.Switch(41) = 0
      Controller.Switch(42) = 0
      Controller.Switch(43) = 0
      Controller.Switch(44) = 0
      Controller.Switch(45) = 0
      sw41.IsDropped = 0:sw42.IsDropped = 0:sw43.IsDropped = 0
      sw44.IsDropped = 0:sw45.IsDropped = 0
      PlaySound SoundFx("solenoid",DOFContactors), 0, 1, 0.05, 0.05
   end if
End Sub
'****Gates
Sub sw49_Hit()
   vpmTimer.PulseSw 49
End Sub
'********Standup Targets
Sub sw34_Hit()
   vpmTimer.PulseSw 34
    PlaySound SoundFX("target",DOFContactors), 0, 1, 0.05, 0.05
End Sub

Sub sw31_Hit()
   vpmTimer.PulseSw 31
    PlaySound SoundFX("target",DOFContactors),0,1,-0.05,0.05
End Sub

Sub sw65_Hit()
   vpmTimer.PulseSw 65
    PlaySound SoundFX("target",DOFContactors),0,1,-0.05,0.05
End Sub

Sub sw70_Hit()
   vpmTimer.PulseSw 70
    PlaySound SoundFX("target",DOFContactors),0,1,-0.05,0.05
End Sub

Sub sw71_Hit()
   vpmTimer.PulseSw 71
    PlaySound SoundFX("target",DOFContactors),0,1,-0.05,0.05
End Sub

Sub sw72_Hit()
   vpmTimer.PulseSw 72
    PlaySound SoundFX("target",DOFContactors),0,1,-0.05,0.05
End Sub

'********Rollovers
Sub Sw17_hit()
   Controller.Switch(17) = 1
End Sub

Sub Sw17_Unhit()
   Controller.Switch(17) = 0
End Sub

Sub Sw18_hit()
   Controller.Switch(18) = 1
End Sub

Sub Sw18_Unhit()
   Controller.Switch(18) = 0
End Sub

Sub Sw23_hit()
   Controller.Switch(23) = 1
End Sub

Sub Sw23_Unhit()
   Controller.Switch(23) = 0
End Sub

Sub Sw24_hit()
   Controller.Switch(24) = 1
End Sub

Sub Sw24_Unhit()
   Controller.Switch(24) = 0
End Sub

Sub Sw33_hit()
   Controller.Switch(33) = 1
   Kicker1.enabled = 1
End Sub

Sub Sw33_Unhit()
   Controller.Switch(33) = 0
End Sub

Sub Sw36_hit()
   Controller.Switch(36) = 1
End Sub

Sub Sw36_Unhit()
   Controller.Switch(36) = 0
End Sub

Sub Sw35_hit()
   Controller.Switch(35) = 1
End Sub

Sub Sw35_Unhit()
   Controller.Switch(35) = 0
End Sub

Sub Sw37_hit()
   Controller.Switch(37) = 1
End Sub

Sub Sw37_Unhit()
   Controller.Switch(37) = 0
End Sub
Sub Sw38_hit()
   Controller.Switch(38) = 1
End Sub

Sub Sw38_Unhit()
   Controller.Switch(38) = 0
End Sub

Sub Sw40_hit()
   Controller.Switch(40) = 1
End Sub

Sub Sw40_Unhit()
   Controller.Switch(40) = 0
End Sub

'*******Genie Trough
Sub Sw30_hit()
   Controller.Switch(30) = 1
End Sub

Sub Sw30_Unhit()
   Controller.Switch(30) = 0
End Sub

Sub Sw29_hit()
   Controller.Switch(29) = 1
End Sub

Sub Sw29_Unhit()
   Controller.Switch(29) = 0
End Sub

Sub Sw28_hit()
   Controller.Switch(28) = 1
End Sub

Sub Sw28_Unhit()
   Controller.Switch(28) = 0
End Sub
'*****Spinner
Sub Spinner_Spin()
   vpmTimer.PulseSw 66
    PlaySound "fx_spinner",0,1,-0.05,0.05
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 = 10 '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
        Next
    End If
    UpdateLamps
End Sub

Sub UpdateLamps
    NFadeL 5, l5
    NFadeL 6, l6
    NFadeL 7, l7
    NFadeL 8, l8
    NFadeL 9, l9
    NFadeLm 10, l10a
    NFadeLm 10, l10b
    NFadeLm 10, l10c
    NFadeLm 10, l10d
    NFadeL 10, l10
    NFadeLm 11, l11a
    NFadeLm 11, l11b
    NFadeLm 11, l11c
    NFadeLm 11, l11d
    NFadeLm 11, l11e
    NFadeL 11, l11
    NFadeL 12, l12
    NFadeL 13, l13
    NFadeL 14, l14
    NFadeL 15, l15
    NFadeL 16, l16
    NFadeObjm 17, l17, "cbL1On", "cbL1" ', "cbL1A", "cbL1B"
   Flashm    17, l17F1
   Flashm    17, l17F2
   Flash    17, l17F
    NFadeObjm 18, l18, "LLOn", "LL" ', "LLA", "LLB"
   Flash    18, l18F
    NFadeLm 19, l19e
    NFadeLm 19, l19d
    NFadeLm 19, l19c
    NFadeLm 19, l19b
    NFadeLm 19, l19a
    NFadeL 19, l19
   NFadeObjm 20, L20P, "LRampPlOn", "LRampPl"
   NFadeLm 20, L20
   Flash    20, L20f
    NFadeObjm 21, l21, "LsOn", "Ls" ', "LsA", "LsB"
   Flash    21, l21F
    NFadeObjm 22, l22, "LshOn", "Lsh" ', "LshA", "LshB"
   Flash    22, l22F
    NFadeObjm 23, l23, "TAOn", "TA" ', "TAA", "TAB
   Flash    23, l23F
    NFadeObjm 24, l24, "LEOn", "LE" ', "LEA", "LEB"
   Flash    24, l24F
    Flashm 25, l25a
    Flash 25, l25
    Flashm 26, l26a
    Flash 26, l26
    Flashm 27, l27a
    Flash 27, l27

    Flashm 30, l30a
    Flash 30, l30
    Flashm 31, l31a
    Flash 31, l31
    Flashm 32, l32a
    Flash 32, l32
    NFadeLm 33, l33
    Flash 33, l33F
    NFadeLm 34, l34
    Flash 34, l34F
    NFadeLm 35, l35
    Flash 35, l35F
    NFadeL 36, l36
'    NFadeL 37, l37
'    NFadeL 38, l38
    NFadeLm 39, l39a
    NFadeLm 39, l39
    Flash 39, l39F
    NFadeL 40, l40
    NFadeLm 41, l41
    Flash 41, l41F
    NFadeLm 42, l42
    Flash 42, l42F
    NFadeLm 43, l43
    Flash 43, l43F
    NFadeL 44, l44
    NFadeL 45, l45
'    NFadeL 46, l46
    NFadeLm 47, l47
    NFadeLm 47, l47a
    Flash 47, l47F
    NFadeLm 48, l48a
    NFadeLm 48, l48b
    NFadeLm 48, l48
    Flash 48, l48F
    NFadeLm 49, l49
    Flash 49, l49F
    NFadeLm 50, l50
    Flash 50, l50F
    NFadeLm 51, l51
    Flash 51, l51F
    NFadeL 52, l52
    NFadeLm 53, l53
    Flash 53, l53F
    NFadeL 54, l54
    NFadeLm 55, l55b
    NFadeLm 55, l55A
    NFadeL 55, l55
    NFadeLm 56, l56
    NFadeLm 56, l56a
    NFadeLm 56, l56b
    NFadeLm 56, l56c
    NFadeL 56, l56d
    NFadeLm 57, l57
    NFadeLm 57, l57a
    NFadeLm 57, l57b
    Flash 57, l57F
    NFadeLm 58, l58
    Flash 58, l58F
    NFadeLm 59, l59
    NFadeLm 59, l59a
    NFadeLm 59, l59b
    NFadeLm 59, l59c
    Flash 59, l59F
    NFadeL 60, l60
    NFadeLm 61, l61
    Flash 61, l61F
    NFadeLm 62, l62
    NFadeLm 62, l62a
    Flash 62, l62F
    NFadeL 63, l63
    NFadeLm 64, l64
    NFadeLm 64, l64a
    NFadeLm 64, l64b
    NFadeLm 64, l64c
    NFadeLm 64, l64e
    NFadeL 64, l64d
'    NFadeL 65, l65
'    NFadeL 66, l66
'    NFadeL 67, l67
'    NFadeL 68, l68
'    NFadeL 71, l71
'    NFadeL 72, l72
'    NFadeL 73, l73
'    NFadeL 74, l74
'    NFadeL 75, l75
    NFadeL 76, l76
    NFadeL 77, l77
    NFadeL 78, l78
    NFadeL 79, l79
    NFadeLm 80, l80
    NFadeLm 81, l81
    Flash 81, l81F
    NFadeL 82, l82
'    NFadeL 83, l83
'    NFadeL 84, l84
    NFadeL 85, l85
    NFadeL 86, l86
   NFadeObjm 87, L87P, "bulbcover1_redOn", "bulbcover1_red"
    NFadeL 87, l87l
   NFadeObjm 88, L88P, "bulbcover1_redOn", "bulbcover1_red"
    NFadeL 88, l88L
    NFadeL 89, l89
    NFadeL 90, l90
    NFadeL 91, l91
    NFadeL 94, l94
    NFadeL 95, l95
    NFadeL 96, l96
    NFadeObjm 97, L97P, "bulbcover1_greenOn", "bulbcover1_green"
   Flash    97, L97f
    NFadeObjm 98, L98P, "bulbcover1_whiteOn", "bulbcover1_white"
   Flash    98, L98f
    NFadeObjm 99, L99P, "bulbcover1_greenOn", "bulbcover1_green"
   Flash    99, L99f
    Flash 100, l100F
    NFadeL 103, l103
    NFadeL 104, l104
    NFadeL 109, l109
    NFadeL 112, l112
    NFadeL 121, l121
    NFadeObjm 113, L113P, "bulbcover1_greenOn", "bulbcover1_green"
   Flash    113, L113f
    NFadeObjm 114, L114P, "TopFlasherWhiteA", "TopFlasherWhite"
   Flash    114, L114
   NFadeObjm 115, L115P, "bulbcover1_blueOn", "bulbcover1_blue"
   Flash    115, L115f
   NFadeObjm 116, L116P, "bulbcover1_yellowOn", "bulbcover1_yellow"
   Flash    116, L116f
   NFadeObjm 117, L117P, "bulbcover1_redOn", "bulbcover1_red"
   Flash    117, L117f
   FadeObj 118, HandP, "hanwithringOn", "hanwithringA", "hanwithringB", "hanwithring"
'    NFadeLm 116, f16b
'    NFadeLm 116, f16
'    Flashm 116, f16a
'    Flash 116, f16c
'    NFadeLm 117, f17a
'    NFadeLm 117, f17b
'    Flashm 117, f17c
'    Flashm 117, f17e
'    Flashm 117, f17f
'    Flash 117, f17d
'    NFadeL 118, f18
'    NFadeLm 119, f19
'    Flashm 119, f19a
'    Flash 119, f19b
'    Flash 120, f20
'    NFadeLm 122, f22
'    NFadeL 123, f23
'    NFadeL 124, f24
'    NFadeL 125, f25
'    NFadeLm 126, f26
'    Flashm 126, f26a
'    Flash 126, f26b
'    NFadeLm 127, f27
'    Flashm 127, f27b
'    Flashm 127, f27d
'    Flash 127, f27a
'    NFadeL 128, f28
'    NFadeL 130, sw27l
   NFadeLm 176, L176
   Flash    176, L176f
   NFadeLm 177, L13
   Flash    177, L177f
   NFadeObjm 178, L178P, "octadome_greenOn", "octadome_green"
   NFadeLm 178, L178L
   Flashm    178, L178f1
   Flashm    178, L178f2
   Flash    178, L178f
   NFadeObjm 179, L179P, "octadome_redOn", "octadome_red"
   NFadeLm 179, L179L
   Flashm    179, L179fa
   Flashm    179, L179fb
   Flash    179, L179f
    NFadeL 180, l180
    NFadeLm 181, l181
    NFadeLm 181, F181a
    FadeObj 181, F181, "FlasherTestOn", "FlasherTestA", "FlasherTestB", "FlasherTest"
   NFadeLm 182, L182
   Flashm    182, L182fa
   Flash    182, L182f
   
End Sub

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.5    ' faster speed when turning on the flasher
        FlashSpeedDown(x) = 0.35 ' 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

' Desktop Objects: Reels & texts (you may also use lights on the desktop)

' Reels

Sub FadeR(nr, object)
    Select Case FadingLevel(nr)
        Case 4:object.SetValue 1:FadingLevel(nr) = 6                   'fading to off...
        Case 5:object.SetValue 0:FadingLevel(nr) = 1                   'ON
        Case 6, 7, 8:FadingLevel(nr) = FadingLevel(nr) + 1             'wait
        Case 9:object.SetValue 2:FadingLevel(nr) = FadingLevel(nr) + 1 'fading...
        Case 10, 11, 12:FadingLevel(nr) = FadingLevel(nr) + 1          'wait
        Case 13:object.SetValue 3:FadingLevel(nr) = 0                  'Off
    End Select
End Sub

Sub FadeRm(nr, object)
    Select Case FadingLevel(nr)
        Case 4:object.SetValue 1
        Case 5:object.SetValue 0
        Case 9:object.SetValue 2
        Case 3:object.SetValue 3
    End Select
End Sub

'Texts

Sub NFadeT(nr, object, message)
    Select Case FadingLevel(nr)
        Case 4:object.Text = "":FadingLevel(nr) = 0
        Case 5:object.Text = message:FadingLevel(nr) = 1
    End Select
End Sub

Sub NFadeTm(nr, object, b)
    Select Case FadingLevel(nr)
        Case 4:object.Text = ""
        Case 5:object.Text = message
    End Select
End Sub
' *********************************************************************
'                      Supporting Ball & Sound Functions
' *********************************************************************

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

Function Pan(ball) ' Calculates the pan for a ball based on the X position on the table. "table1" is the name of the table
    Dim tmp
    tmp = ball.x * 2 / table1.width-1
    If tmp > 0 Then
        Pan = Csng(tmp ^10)
    Else
        Pan = Csng(-((- tmp) ^10) )
    End If
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

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

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

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

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

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

Sub RollingUpdate()
    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 < 130 Then
            rolling(b) = True
            PlaySound("fx_ballrolling" & b), -1, Vol(BOT(b) ), Pan(BOT(b) ), 0, Pitch(BOT(b) ), 1, 0
        Else
            If rolling(b) = True Then
                StopSound("fx_ballrolling" & b)
                rolling(b) = False
            End If
        End If
    Next
End Sub



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

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

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

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

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

Sub Gates_Hit (idx)
   PlaySound "gate4", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
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), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
   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), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
   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), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
      Case 2 : PlaySound "rubber_hit_2", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
      Case 3 : PlaySound "rubber_hit_3", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
   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), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
      Case 2 : PlaySound "flip_hit_2", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
      Case 3 : PlaySound "flip_hit_3", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
   End Select
End Sub

'*****************************************************************************
'*                                                                           *
'*                      CORK SCREW SKILL SHOT CODE                           *
'*                              BY RASCAL                                    *
'*                                                                           *
'*****************************************************************************  
Dim posangle,storevely,ball
Sub Kicker1_Hit()

   storevely = ActiveBall.vely           'Grab Y velosity at the start of the loop
   If storevely > -8 then Kicker1.Kick 180, 10:Exit Sub
   Kicker1.DestroyBall                  'Destroy the current ball

   Set ball =    Kicker1.CreateBall         'Create a new object of the ball with a handle

   ball.z = 200                     'Set the height of the ball while still in the kicker to match the ball destroyed (add 25 units more because half the ball is in the kicker)
   posangle = 100                     'Set the starting angle, which is the radian value which is equal to half the radius of the loop (loop is a radius of 200)
   Kicker1.TimerEnabled = True            'Start the timer
   Kicker1.TimerInterval = 80 + storevely   'Set the interval to the timer with adjusted speed to try and match the speed of the real ball before it was destroyed using the stored vely value
End Sub



Sub Kicker1_Timer()
   ball.z = ball.z + (95 * cos(posangle))   'Formula for plotting the Z position of the ball to make a curve or circle (the 100 is half the distance or center of the loop)
   ball.y = ball.y + (95 * sin(posangle))   'Formula for plotting the Y position of the ball to make a curve or circle (the 100 is half the distance or center of the loop)
   ball.x = ball.x - 50               'Subtract from the ball X position accordingly to make the ball cork screw to the left (adjust the number though tests, so the ball made it to the left ramp)
   If posangle = 359 then posangle = -1   'Set the position angle to -1 when the position angle would reach 360 degrees and next line will make it 0
   posangle = posangle + 1               'Increment the position angle by 1
   If (Int(ball.z) >= 360 and (storevely > -20)) or Int(ball.z) <= 210 then 'If the ball is slow and reaches the top of the loop, or the ball is completing the loop then do the following
      Kicker1.TimerEnabled = False      'Stop the timer
      Kicker1.Kick 0, 0               'Kick the ball with 0 force, if this is the magic speed then the ball drops into the hat. Magic speed is between -9 and -10
      If Int(ball.z) <= 210 then ball.vely = storevely+ -10 'If ball is completing the loop add the Y volisity back to the ball minus some energy spent making the loop (guessed 4)
      Kicker1.enabled = 0
   End If
End Sub

Sub Kicker2_Hit()
   Kicker2.Kick 333, 30
End Sub

Sub trigger2_UnHit()
   'ActiveBall.Velz = -10
End Sub