[TUTO] Pin2DMD Tables Supports ( DMD Couleurs )

 Option Explicit


    Randomize


'************ BEGIN PIN2DMD PALETTE LOADING **************


'************* thanks to Rascal and gtxjoe ***************


Const PIN2DMD = True


Const PIN2DMDDIR = "C:\PIN2DMD-master\tools\latest"





Dim oShell


Dim WScript


Dim ORIGDIR


Set oShell = CreateObject("WScript.Shell")


ORIGDIR = oShell.CurrentDirectory


oShell.CurrentDirectory = PIN2DMDDIR


If PIN2DMD = True then oShell.run "pin2dmd.exe /p 3 ",,TRUE


oShell.CurrentDirectory = ORIGDIR


Set oShell = Nothing





Dim DelayTime, StartTime


DelayTime = 0


StartTime = Timer


Do While DelayTime < 1


    DelayTime = Timer - StartTime


Loop


'************* END PIN2DMD PALETTE LOADING ***************








  Const cGameName = "mtl_164"


     Const UseSolenoids = 1


     Const UseLamps = 0


     Const UseSync = 1


     Const HandleMech = 0


     Const SSolenoidOn = "Solenoid"


     Const SSolenoidOff = ""


     Const SCoin = "CoinIn"


 


    Dim xx


    Dim Bump1, Bump2, Bump3, Mech3bank,bsTrough,bsLHole, bsRHole,dtl,cbRight,turntable,cbCaptive,cbCaptive2


 Dim PlungerIM,LMag,RMag


 Dim cBall


 Dim VarHidden, UseVPMDMD


If table.ShowDT = true then


 'UseVPMDMD = true


 VarHidden = 0


 lockdown.visible = true


else


 'UseVPMDMD = false


 VarHidden = 0


 lockdown.visible = false


end if


On Error Resume Next


ExecuteGlobal GetTextFile("controller.vbs")


If Err Then MsgBox "Can't open controller.vbs"


On Error Goto 0


  LoadVPM "01560000", "sam.VBS", 3.10





 Set cBall = ckicker.createball


 ckicker.Kick 0, 0


  Sub table_Init


 UpPost.Isdropped=true


 With Controller


  .GameName = cGameName


  If Err Then MsgBox "Can't start Game " & cGameName & vbNewLine & Err.Description:Exit Sub


  .SplashInfoLine = "Metallica (Stern 2013)"


  .HandleKeyboard = 0


  .ShowTitle = 0


  .ShowDMDOnly = 1


  .ShowFrame = 0


  .HandleMechanics = 1


  .Hidden = VarHidden


  On Error Resume Next


  .Run GetPlayerHWnd


  If Err Then MsgBox Err.Description


 End With


    On Error Goto 0


'Trough


    Set bsTrough = New cvpmBallStack


    bsTrough.InitSw 0, 21, 20, 19, 18, 0, 0, 0


    bsTrough.InitKick BallRelease, 90, 8


    bsTrough.InitExitSnd SoundFX("ballrelease",DOFContactors), "Solenoid"


    bsTrough.Balls = 4


'Hole bsRHole - right eject


      Set bsRHole = New cvpmBallStack


      With bsRHole


          .InitSw 0, 51, 0, 0, 0, 0, 0, 0


          .InitKick kicker3, 209, 20


          .KickZ = 0.4


          .InitExitSnd SoundFX("popper_ball",DOFContactors), "Solenoid"


          .KickForceVar = 2


      End With


 Set cbCaptive=New cvpmCaptiveBall


 cbCaptive.InitCaptive CapTrigger,CapWall,Array(fkicker,ekicker),10


 cbCaptive.NailedBalls=1


 cbCaptive.Start


 cbCaptive.ForceTrans=0.9


 cbCaptive.MinForce=4


 cbCaptive.CreateEvents "cbCaptive"


 fkicker.CreateBall


     vpmNudge.TiltSwitch=-7


     vpmNudge.Sensitivity=.5


     vpmNudge.TiltObj=Array(Bumper1b,Bumper2b,Bumper3b,LeftSlingshot,RightSlingshot)


 PinMAMETimer.Interval = PinMAMEInterval


 PinMAMETimer.Enabled = 1


 


 Set LMag=New cvpmMagnet


 LMag.InitMagnet LMagnet,22


 LMag.GrabCenter=True


 Set RMag=New cvpmMagnet


 RMag.InitMagnet RMagnet,60


 RMag.GrabCenter=True


 End Sub


 Sub table_Paused:Controller.Pause = 1:End Sub


 Sub table_unPaused:Controller.Pause = 0:End Sub





 Sub table_KeyDown(ByVal keycode)


  If Keycode = LeftFlipperKey then


 End If


  If Keycode = RightFlipperKey then


 End If


    If keycode = PlungerKey Then Plunger.Pullback


    If vpmKeyDown(keycode) Then Exit Sub


End Sub


   


Sub table_KeyUp(ByVal keycode)


 If vpmKeyUp(keycode) Then Exit Sub


  If Keycode = LeftFlipperKey then


  SolLFlipper false


 End If


  If Keycode = RightFlipperKey then


  SolRFlipper False


 End If


 If Keycode = StartGameKey Then Controller.Switch(16) = 0


    If keycode = PlungerKey Then


  Plunger.Fire


        PlaySound "Plunger"


 End If


End Sub


SolCallback(1) = "solTrough"


SolCallback(2) = "solAutofire"


SolCallback(3) = "LMag.MagnetOn="


SolCallback(4) = "RMag.MagnetOn="


SolCallback(5) = "SnakeKick"


SolCallback(6) = "bsRHole.SolOut"


SolCallback(7) = "orbitpost"


SolCallback(9)  = "vpmSolSound SoundFX(""jet3"",DOFContactors),"


SolCallback(10) = "vpmSolSound SoundFX(""jet3"",DOFContactors),"


SolCallback(11) = "vpmSolSound SoundFX(""jet3"",DOFContactors),"


SolCallback(12) = "Resetinline"


SolCallback(15) = "SolLFlipper"


SolCallback(16) = "SolRFlipper"


SolCallback(18) = "SolSparkyHead"


SolCallback(19) = "SetLamp 119,"


SolCallback(20) = "SetLamp 120,"


SolCallback(21) = "SetLamp 121,"


SolCallback(22) = "SetLamp 122,"


SolCallback(23) = "SetLamp 123,"


SolCallback(25) = "SetLamp 125,"


SolCallback(26) = "SetLamp 126,"


SolCallback(27) = "SetLamp 127,"


SolCallback(28) = "SetLamp 128,"


SolCallback(29) = "SetLamp 129,"


SolCallback(30) = "setlamp 130," 'captive ball flasher


SolCallback(31) = "setlamp 131," 'coffin insert flasher x2


SolCallback(32) = "setlamp 132," 'electric chair insert flasher





controller.switch(60) = 1


controller.switch(61) = 1


controller.switch(62) = 1


Sub sw60_hit


sw60.Isdropped=True


Controller.switch (60)= 0


PlaySound "DTC"


End sub


Sub sw61_hit


sw61.Isdropped=True


Controller.switch (61)= 0


PlaySound "DTC"


End sub


Sub sw62_hit


sw62.Isdropped=True


Controller.switch (62)= 0


PlaySound "DTC"


End sub


Sub resetinline(Enabled)


 If Enabled Then


  sw60.Isdropped=false


  Controller.switch (60)=1


  sw61.Isdropped=False


  Controller.switch (61)=1


  sw62.Isdropped=False


  Controller.switch (62)=1


  PlaySound "DTReset"


 End If


 End Sub


Sub SnakeKick(enabled)


    If enabled Then


 snakejawf.rotatetostart


 sw54.timerenabled = true


    End If


End Sub


Sub sw54_Timer()


 PlaySound "popper_ball"


    sw54.Kick 195, 44


    controller.switch (54) = false


 sw54.timerenabled = false


End Sub





Sub solTrough(Enabled)


 If Enabled Then


  bsTrough.ExitSol_On


  vpmTimer.PulseSw 22


 End If


 End Sub


Sub solAutofire(Enabled)


 If Enabled Then


  PlungerIM.AutoFire


 End If


 End Sub


Sub orbitpost(Enabled)


 If Enabled Then


  UpPost.Isdropped=false


 Else


  UpPost.Isdropped=true


 End If


 End Sub





Sub SolSparkyHead(Enabled)


    If Enabled Then


        SparkyShake


    End If


End Sub


Sub SparkyShake


    cball.velx = 10 + 2 * RND(1)


    cball.vely = 2 * (RND(1) - RND(1) )


End Sub


Sub Sparky


    Sparkyhead.rotx = -(ckicker.y - cball.y)


    'Sparkyhead.transx = (ckicker.y - cball.y) / 2


    Sparkyhead.roty = cball.x - ckicker.x


End Sub


Sub SolLFlipper(Enabled)


     If Enabled Then


   PlaySound SoundFX("FlipperUpLeft",DOFContactors)


   LeftFlipper.RotateToEnd


     Else


   PlaySound SoundFX("FlipperDown",DOFContactors)


   LeftFlipper.RotateToStart


     End If


 End Sub


Sub SolRFlipper(Enabled)


     If Enabled Then


   PlaySound SoundFX("FlipperUpRight",DOFContactors)


   RightFlipper.RotateToEnd


     Else


   PlaySound SoundFX("FlipperDown",DOFContactors)


   RightFlipper.RotateToStart


     End If


 End Sub


 Dim dBall, dZpos


 Sub kicker3_Hit


     Set dBall = ActiveBall


     PlaySound "scoopleft"


     dZpos = 35


     Me.TimerInterval = 2


     Me.TimerEnabled = 1


 if ballcount < 2 Then GIOff:End If


 End Sub


 


Sub kicker3_unhit


 GIOn


End Sub


 Sub kicker3_Timer


     dBall.Z = dZpos


     dZpos = dZpos-4


     If dZpos <-30 Then


         Me.TimerEnabled = 0


         Me.DestroyBall


         bsRHole.AddBall Me


     End If


 End Sub


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


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


     'Switches


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


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


Sub CapWall_Hit:PlaySound "fx_collide":End Sub


Sub sw1_Hit:Controller.Switch(1) = 1:PlaySound "sensor":End Sub


Sub sw1_UnHit:Controller.Switch(1) = 0:End Sub


Sub sw3_Hit:Controller.Switch(3) = 1:PlaySound "sensor":End Sub


Sub sw3_UnHit:Controller.Switch(3) = 0:End Sub


Sub sw4_Hit:vpmTimer.PulseSw 4:PlaySound SoundFX("target",DOFContactors):End Sub  


Sub sw7_Hit:vpmTimer.PulseSw 7:PlaySound SoundFX("target",DOFContactors):End Sub  


Sub sw9_Hit:vpmTimer.PulseSw 9:PlaySound SoundFX("target",DOFContactors):End Sub 


 


Sub sw23_Hit:Controller.Switch(23) = 1:PlaySound "sensor":End Sub


Sub sw23_UnHit:Controller.Switch(23) = 0:End Sub


Sub sw24_Hit:Controller.Switch(24) = 1:PlaySound "sensor":End Sub


Sub sw24_UnHit:Controller.Switch(24) = 0:End Sub


Sub sw25_Hit:Controller.Switch(25) = 1:PlaySound "sensor":End Sub


Sub sw25_UnHit:Controller.Switch(25) = 0:End Sub


Sub sw28_Hit:Controller.Switch(28) = 1:PlaySound "sensor":End Sub


Sub sw28_UnHit:Controller.Switch(28) = 0:End Sub


Sub sw29_Hit:Controller.Switch(29) = 1:PlaySound "sensor":End Sub


Sub sw29_UnHit:Controller.Switch(29) = 0:End Sub


Sub sw35_Hit:vpmTimer.PulseSw 35:PlaySound SoundFX("target",DOFContactors):End Sub  


Sub sw36_Hit():playsound SoundFX("target",DOFContactors):vpmTimer.PulseSw 36:sw36p.TransX = 7:sw36.TimerEnabled = 1:End Sub


Sub sw36_Timer:sw36p.TransX = 0:Me.TimerEnabled = 0:End Sub


Sub sw37_Hit():playsound SoundFX("target",DOFContactors):vpmTimer.PulseSw 37:sw37p.TransX = 7:sw37.TimerEnabled = 1:End Sub


Sub sw37_Timer:sw37p.TransX = 0:Me.TimerEnabled = 0:End Sub


Sub sw40_Hit():playsound SoundFX("target",DOFContactors):vpmTimer.PulseSw 40:sw40p.TransX = 7:sw40.TimerEnabled = 1:End Sub


Sub sw40_Timer:sw40p.TransX = 0:Me.TimerEnabled = 0:End Sub


Sub sw41_Hit():playsound SoundFX("target",DOFContactors):vpmTimer.PulseSw 41:sw41p.TransX = 7:sw41.TimerEnabled = 1:End Sub


Sub sw41_Timer:sw41p.TransX = 0:Me.TimerEnabled = 0:End Sub


Sub sw42_Hit():playsound SoundFX("target",DOFContactors):vpmTimer.PulseSw 42:End Sub


Sub sw43_Hit:Controller.Switch(43) = 1:PlaySound "sensor":End Sub


Sub sw43_UnHit:Controller.Switch(43) = 0:End Sub


Sub sw44_Hit:Controller.Switch(44) = 1:PlaySound "sensor":End Sub


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


Sub sw45_Hit:Controller.Switch(45) = 1:PlaySound "sensor":End Sub


Sub sw45_UnHit:Controller.Switch(45) = 0:End Sub


Sub sw46_Hit:Controller.Switch(46) = 1:PlaySound "sensor":End Sub


Sub sw46_UnHit:Controller.Switch(46) = 0:End Sub


Sub sw47_Hit:Playsound "Gate":Controller.Switch(47)=1:PlaySound "fx_metalrollingright", 0, 150, Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0:End Sub


Sub sw47_unHit:Controller.Switch(47)=0:End Sub


Sub sw50_Hit:Playsound "Gate":Controller.Switch(50)=1:PlaySound "fx_metalrollingleft", 0, 150, Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0:End Sub


Sub sw50_unHit:Controller.Switch(50)=0:End Sub


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


Sub sw52_unHit:Controller.Switch(52)=0:End Sub


Sub sw53_Hit():vpmTimer.PulseSw 53:End Sub


Sub sw54_Hit()


 Dim RandNum


 RandNum = Int(3*Rnd+1)


 If RandNum = 2 Then


       sw54.Kick 225, 2


 Else


  controller.switch (54)=true:


  snakejawf.rotatetoend


 End If


 Playsound "kicker_enter_center"


End Sub


Sub LMagnet_Hit:LMag.AddBall ActiveBall:End Sub 


Sub LMagnet_UnHit:LMag.RemoveBall ActiveBall:End Sub


Sub RMagnet_Hit


 RMag.AddBall ActiveBall


 If RMag.MagnetOn=true then


  GIOff


 End If


End Sub


Sub RMagnet_UnHit:RMag.RemoveBall ActiveBall:GIOn:End Sub


Sub RHelp2_Hit():playsound"ballhit":End Sub


Sub RHelp1_Hit():playsound"ballhit":End Sub


Dim BallCount:BallCount = 0


   Sub Drain_Hit()


 PlaySound "Drain"


 BallCount = BallCount - 1


 bsTrough.AddBall Me


 If BallCount = 0 then GIOff


   End Sub


   Sub BallRelease_UnHit()


  BallCount = BallCount + 1


  GIOn


 End Sub


Sub LeftSlingShot_Slingshot


 Leftsling = True


 Controller.Switch(26) = 1


  PlaySound Soundfx("left_slingshot",DOFContactors):LeftSlingshot.TimerEnabled = 1


  End Sub


Dim Leftsling:Leftsling = False


Sub LS_Timer()


 If Leftsling = True and Left1.ObjRotZ < -7 then Left1.ObjRotZ = Left1.ObjRotZ + 2


 If Leftsling = False and Left1.ObjRotZ > -20 then Left1.ObjRotZ = Left1.ObjRotZ - 2


 If Left1.ObjRotZ >= -7 then Leftsling = False


 If Leftsling = True and Left2.ObjRotZ > -212.5 then Left2.ObjRotZ = Left2.ObjRotZ - 2


 If Leftsling = False and Left2.ObjRotZ < -199 then Left2.ObjRotZ = Left2.ObjRotZ + 2


 If Left2.ObjRotZ <= -212.5 then Leftsling = False


 If Leftsling = True and Left3.TransZ > -23 then Left3.TransZ = Left3.TransZ - 4


 If Leftsling = False and Left3.TransZ < -0 then Left3.TransZ = Left3.TransZ + 4


 If Left3.TransZ <= -23 then Leftsling = False


End Sub


 Sub LeftSlingShot_Timer:Me.TimerEnabled = 0:Controller.Switch(26) = 0:End Sub


 Sub RightSlingShot_Slingshot


 Rightsling = True


 Controller.Switch(27) = 1


  PlaySound Soundfx("right_slingshot",DOFContactors):RightSlingshot.TimerEnabled = 1


  End Sub


 Dim Rightsling:Rightsling = False


Sub RS_Timer()


 If Rightsling = True and Right1.ObjRotZ > 7 then Right1.ObjRotZ = Right1.ObjRotZ - 2


 If Rightsling = False and Right1.ObjRotZ < 20 then Right1.ObjRotZ = Right1.ObjRotZ + 2


 If Right1.ObjRotZ <= 7 then Rightsling = False


 If Rightsling = True and Right2.ObjRotZ < 212.5 then Right2.ObjRotZ = Right2.ObjRotZ + 2


 If Rightsling = False and Right2.ObjRotZ > 199 then Right2.ObjRotZ = Right2.ObjRotZ - 2


 If Right2.ObjRotZ >= 212.5 then Rightsling = False


 If Rightsling = True and Right3.TransZ > -23 then Right3.TransZ = Right3.TransZ - 4


 If Rightsling = False and Right3.TransZ < -0 then Right3.TransZ = Right3.TransZ + 4


 If Right3.TransZ <= -23 then Rightsling = False


End Sub


 


 Sub RightSlingShot_Timer:Me.TimerEnabled = 0:Controller.Switch(27) = 0:End Sub





    Const IMPowerSetting = 45


    Const IMTime = 0.6


    Set plungerIM = New cvpmImpulseP


    With plungerIM


        .InitImpulseP swplunger, IMPowerSetting, IMTime


        .Random 0.3


        .InitExitSnd "autoplunger", "plunger"


        .CreateEvents "plungerIM"


    End With


      Sub Bumper1b_Hit


      vpmTimer.PulseSw 31


      PlaySound SoundFX("fx_bumper1",DOFContactors)


     End Sub


    


 


      Sub Bumper2b_Hit


      vpmTimer.PulseSw 30


      PlaySound SoundFX("fx_bumper1",DOFContactors)


       End Sub


 


      Sub Bumper3b_Hit


      vpmTimer.PulseSw 32


      PlaySound SoundFX("fx_bumper1",DOFContactors)


       End Sub


 


 Dim LampState(200), FadingLevel(200), FadingState(200)


Dim FlashState(200), FlashLevel(200), FlashMin(200), FlashMax(200)


Dim FlashSpeedUp, FlashSpeedDown


Dim x


AllLampsOff()


LampTimer.Interval = 40 'lamp fading speed


LampTimer.Enabled = 1


'


FlashInit()


FlasherTimer.Interval = 10 'flash fading speed


FlasherTimer.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)


            FadingLevel(chgLamp(ii, 0) ) = chgLamp(ii, 1) + 4


   FlashState(chgLamp(ii, 0) ) = chgLamp(ii, 1)


        Next


    End If


    UpdateLamps


End Sub


Sub FlashInit


    Dim i


    For i = 0 to 200


        FlashState(i) = 0


        FlashLevel(i) = 0


    Next


    FlashSpeedUp = 50   ' fast speed when turning on the flasher


    FlashSpeedDown = 10 ' slow speed when turning off the flasher, gives a smooth fading


    AllFlashOff()


End Sub


Sub AllFlashOff


    Dim i


    For i = 0 to 200


        FlashState(i) = 0


    Next


End Sub


 


 Sub UpdateLamps


   NFadeL 4, l4


   NFadeL 5, l5


   NFadeL 6, l6


   NFadeL 7, l7


   NFadeL 8, l8


   NFadeL 9, l9


   NFadeL 10, l10


   NFadeL 11, l11


   NFadeL 12, l12


   NFadeL 13, l13


   NFadeL 14, l14


   NFadeL 15, l15


   NFadeL 16, l16


   NFadeL 17, l17


   NFadeL 18, l18


   NFadeL 19, l19


   NFadeL 20, l20


   NFadeL 21, l21


   NFadeL 22, l22


   NFadeL 23, l23


   NFadeL 24, l24


   NFadeL 25, l25


   NFadeL 26, l26


   NFadeL 27, l27


   NFadeL 29, l29


   NFadeL 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 40, l40


   NFadeL 41, l41


   NFadeL 42, l42


   NFadeL 43, l43


   NFadeL 44, l44


   NFadeL 45, l45


   NFadeL 46, l46


   NFadeL 47, l47


   NFadeL 48, l48


   NFadeL 49, l49


   NFadeL 50, l50


   NFadeL 51, l51


   NFadeL 52, l52


   NFadeL 53, l53


   NFadeL 54, l54


   NFadeL 55, l55


   NFadeL 56, l56


   NFadeL 57, l57


   NFadeL 58, l58


   NFadeL 60, l60


   NFadeL 61, l61


   NFadeL 62, l62


   NFadeL 63, l63


   NFadeL 64, l64


   'NFadeLm 65, l65


   NFadeL 67, l67


   NFadeL 68, l68


   NFadeL 69, l69


   'NFadeLm 70, l70


   'NFadeLm 71, l71


   NFadeL 73, l73


   NFadeL 75, l75


   NFadeL 78, l78


 NFadeLm 121, l21a


 NFadeLm 121, l21b


 NFadeL 121, l21c


 NFadeLm 122, l22a


 NFadeLm 122, l22b


 NFadeL 122, l22c


   NFadeLm 123, f123


   NFadeL 123, f123b


   NFadeLm 129, f129


   NFadeL 129, f129b


'NFadeLm 70, f70a


'NFadeL 70, f70b


'NFadeLm 126, f126a


'NFadeL 126, f126b


'NFadeLm 132, f132a


'NFadeLm 68, f68a


'NFadeLm 68, f68b


'NFadeL 68, f68c


'NFadeLm 69, f69a


'NFadeLm 69, f69b


'NFadeL 69, f69c


NFadeL 119, f119


NFadeL 120, f120


NFadeL 125, f125


NFadeLm 126, f126a


NFadeL 126, f126b


NFadeLm 127, f127a


NFadeL 127, f127b


NFadeLm 128, f128a


NFadeLm 128, f128b


NFadeLm 128, f128c


NFadeL 128, f128d


'Flash 65, l65f


'Flash 70, l70f


'Flash 71, l71f


NFadeL 65, l65


NFadeL 70, l70


NFadeL 71, l71


' FlashAR 60, f160, "bf_on", "bf_a", "bf_b", ARRefresh


' FlashAR 61, f161, "bf_on", "bf_a", "bf_b", ARRefresh


' FlashAR 62, f162, "bf_on", "bf_a", "bf_b", ARRefresh


' NFadeL 60, bumper2b


' NFadeL 61, bumper1b


' NFadeL 62, bumper3b


' FadeL 63, l63, l63a


'


' FadeLm 120, l90, l90a


' FlashAR 120, f120, "wf_on", "wf_a", "wf_b", ARRefresh


' FadeLm 122, l89, l89a


' FlashAR 122, f189, "rf_on", "rf_a", "rf_b", ARRefresh


' FlashAR 121, f121, "yf_on", "yf_a", "yf_b", ARRefresh


' FlashARm 123, f125, "bf_on", "bf_a", "bf_b", ARRefresh


' FlashAR 123, f125a, "bf_on", "bf_a", "bf_b", ARRefresh


' FlashAR 126, f126, "yf_on", "yf_a", "yf_b", ARRefresh


' FlashAR 127, f127, "wf_on", "wf_a", "wf_b", ARRefresh


' FlashAR 129, f129, "wf_on", "wf_a", "wf_b", ARRefresh


' FlashARm 131, f131a, "rf_on", "rf_a", "rf_b", ARRefresh


' FlashAR 131, f131, "rf_on", "rf_a", "rf_b", ARRefresh


' FlashAR 132, f132, "rf_on", "rf_a", "rf_b", ARRefresh


   End Sub


Sub FadePrim(nr, pri, a, b, c, d)


    Select Case FadingLevel(nr)


        Case 2:pri.image = d:FadingLevel(nr) = 0


        Case 3:pri.image = c:FadingLevel(nr) = 1


        Case 4:pri.image = b:FadingLevel(nr) = 2


        Case 5:pri.image = a:FadingLevel(nr) = 3


    End Select


End Sub


Sub NFadeL(nr, a)


    Select Case FadingLevel(nr)


        Case 4:a.state = 0:FadingLevel(nr) = 0


        Case 5:a.State = 1:FadingLevel(nr) = 1


    End Select


End Sub


Sub NFadeLm(nr, a)


    Select Case FadingLevel(nr)


        Case 4:a.state = 0


        Case 5:a.State = 1


    End Select


End Sub


Sub Flash(nr, object)


    Select Case FlashState(nr)


        Case 0 'off


            FlashLevel(nr) = FlashLevel(nr) - FlashSpeedDown


            If FlashLevel(nr) < 0 Then


                FlashLevel(nr) = 0


                FlashState(nr) = -1 'completely off


            End if


            Object.opacity = FlashLevel(nr)


        Case 1 ' on


            FlashLevel(nr) = FlashLevel(nr) + FlashSpeedUp


            If FlashLevel(nr) > 1000 Then


                FlashLevel(nr) = 1000


                FlashState(nr) = -2 'completely on


            End if


            Object.opacity = FlashLevel(nr)


    End Select


End Sub


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


 


Sub SetLamp(nr, value)


    If value = 0 AND LampState(nr) = 0 Then Exit Sub


    If value = 1 AND LampState(nr) = 1 Then Exit Sub


    LampState(nr) = abs(value) + 4


FadingLevel(nr ) = abs(value) + 4: FadingState(nr ) = abs(value) + 4


End Sub


Sub SetFlash(nr, stat)


    FlashState(nr) = ABS(stat)


End Sub


Sub FlasherTimer_Timer()


 End Sub


 


Set MotorCallback = GetRef("GameTimer")


Sub GameTimer


    Sparky


    RollingSound


End Sub


Sub UpdateFlipperLogo_Timer


    LFLogo.RotY = LeftFlipper.CurrentAngle


    RFlogo.RotY = RightFlipper.CurrentAngle


 'sw40p.x = sw40.x


 'sw40p.y = sw40.y


End Sub


Sub GIOn


 dim bulb


 for each bulb in Collection1


 bulb.state = 1


 next


End Sub


Sub GIOff


 dim bulb


 for each bulb in Collection1


 bulb.state = 0


 next


End Sub


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


'                      Supporting Ball & Sound Functions


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


Sub Pins_Hit (idx)


 PlaySound "pinhit_low", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0


End Sub


Sub Targets_Hit (idx)


 PlaySound SoundFX("target",DOFContactors), 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0


End Sub


Sub TargetBankWalls_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 Spinner_Spin


 PlaySound "fx_spinner",0,.25,0,0.25


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


Function Vol(ball) ' Calculates the Volume of the sound based on the ball speed


    Vol = Csng(BallVel(ball) ^2 / 1)


End Function


Function Pan(ball) ' Calculates the pan for a ball based on the X position on the table. "table" is the name of the table


    Dim tmp


    tmp = ball.x * 2 / table.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


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


'      JP's VP10 Rolling Sounds


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


Const tnob = 8 ' 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 AND BOT(b).z > 0 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


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


' 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


Dim leftdrop:leftdrop = 0


Sub leftdrop1_Hit:leftdrop = 1:End Sub


Sub leftdrop2_Hit:


 If leftdrop = 1 then


  PlaySound "drop_left"


 End If


 StopSound "fx_metalrollingleft"


 leftdrop = 0


End Sub


Dim rightdrop:rightdrop = 0


Sub rightdrop1_Hit:rightdrop = 1:End Sub


Sub rightdrop2_Hit


 If rightdrop = 1 then


  PlaySound "drop_Right"


 End If


 StopSound "fx_metalrollingright"


 rightdrop = 0


End Sub


Sub RLS_Timer()


 sw47p.RotX = -(sw47g.currentangle)


 sw50p.RotX = -(sw50g.currentangle)


End Sub


Sub PrimT_Timer


' If sw60.isdropped = true then sw60f.rotatetoend:end if


' if sw60.isdropped = false then sw60f.rotatetostart:end if


 snakejaw.objrotx = snakejawf.currentangle


 'l65f.opacity = l65.intensityscale * 10.8


 'l70f.opacity = l70.intensityscale * 10.8


 'l71f.opacity = l71.intensityscale * 10.8


 if l60.State = 1 then l60f.visible = 1 else l60f.visible = 0


 if l61.State = 1 then l61f.visible = 1 else l61f.visible = 0


 if l62.State = 1 then l62f.visible = 1 else l62f.visible = 0


 if l65.State = 1 then l65f.visible = 1 else l65f.visible = 0


 if l70.State = 1 then l70f.visible = 1 else l70f.visible = 0


 if l71.State = 1 then l71f.visible = 1 else l71f.visible = 0


 if l21a.State = 1 then f21a.visible = 1 else f21a.visible = 0


 if l21a.State = 1 then f21b.visible = 1 else f21b.visible = 0


 if l21a.State = 1 then f21c.visible = 1 else f21c.visible = 0


 if l22a.State = 1 then f22a.visible = 1 else f22a.visible = 0


 if l22a.State = 1 then f22b.visible = 1 else f22b.visible = 0


 if l22a.State = 1 then f22c.visible = 1 else f22c.visible = 0


End Sub





'************ BEGIN PIN2DMD PALETTE RESET **************


'************ thanks to Rascal and gtxjoe **************


Sub ResetPalette


Dim rShell


Dim WScript


Set rShell = CreateObject("WScript.Shell")


rShell.CurrentDirectory = "C:\PIN2DMD-master\tools\latest"


rShell.run "pin2dmd.exe /c",,TRUE


Set rShell = Nothing


End Sub





Sub table_exit():Controller.Stop:ResetPalette:End Sub


'************* END PIN2DMD PALETTE RESET ***************