Ali-v1.0.1.vbs

' Ali / IPD No. 43 / Stern March, 1980 / 4 Players
' http://www.ipdb.org/machine.cgi?id=43
' VPX table by JPSalas 2017
' Dipswitches from the older table by Luvthatapex, Joe Entropy and Moonchild
' Press F7 for a friendly dipswitch, or F6 to edit manually the dipswitches
' DOF commands by arngrim

' Thalamus 2018-07-18
' Added/Updated "Positional Sound Playback Functions" and "Supporting Ball & Sound Functions"
' No special SSF tweaks yet.
' Changed UseSolenoids=1 to 2
' Wob 2018-08-08
' Added vpmInit Me and cSingleLFlip, cSingleRFlip for FastFlips Support

Option Explicit
Randomize

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

Const BallSize = 50

LoadVPM "01120100", "stern.vbs", 3.02

Dim VarHidden
If Table1.ShowDT = true then
    VarHidden = 1
else
    VarHidden = 0
    For each x in aReels
        x.Visible = 0
    Next
    lrail.Visible = 0
    rrail.Visible = 0
end if

Dim bsTrough, dtTBank, dtLBank, bsHole1, bsHole2, bsHole3, bsRHole
Dim x, i, j, k 'used in loops

Const cGameName = "ali"

Const UseSolenoids = 2
' Wob: Added for Fast Flips
Const cSingleLFlip = 0
Const cSingleRFlip = 0
Const UseLamps = 0
Const UseGI = 0
Const UseSync = 0
Const HandleMech = 0

' Standard Sounds
Const SSolenoidOn = "fx_Solenoid"
Const SSolenoidOff = ""
Const SCoin = "fx_coin"

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

Sub Table1_Init
  vpmInit Me
    With Controller
        .GameName = cGameName
        .SplashInfoLine = "Ali, Stern 1980" & vbNewLine & "VPX table by JPSalas v1.0.1"
        .HandleMechanics = 0
        .HandleKeyboard = 0
        .ShowDMDOnly = 1
        .ShowFrame = 0
        .ShowTitle = 0
        .Hidden = VarHidden
        If Err Then MsgBox Err.Description
    End With
    On Error Goto 0
    Controller.SolMask(0) = 0
    vpmTimer.AddTimer 2000, "Controller.SolMask(0)=&Hffffffff'" 'ignore all solenoids - then add the timer to renable all the solenoids after 2 seconds
    Controller.Run

    ' Nudging
    vpmNudge.TiltSwitch = 7
    vpmNudge.Sensitivity = 0.1
    vpmNudge.TiltObj = Array(LBumper, BBumper, RBumper, LeftSlingshot, RightSlingshot)

    ' Trough
    Set bsTrough = New cvpmBallStack
    With bsTrough
        bsTrough.InitNoTrough BallRelease, 33, 115, 3
        .InitExitSnd "fx_ballrel", "fx_Solenoid"
        .Balls = 1
    End With

    ' Left Drop targets
    set dtLBank = new cvpmdroptarget
    With dtLBank
        .InitDrop Array(sw22, sw23, sw24), Array(22, 23, 24)
        .Initsnd SoundFX("fx_droptarget",DOFDropTargets), SoundFX("fx_resetdrop",DOFContactors)
    End With

    ' Top Drop targets
    set dtTBank = new cvpmdroptarget
    With dtTBank
        .InitDrop Array(sw19, sw20, sw21), Array(19, 20, 21)
        .Initsnd SoundFX("fx_droptarget",DOFDropTargets), SoundFX("fx_resetdrop",DOFContactors)
    End With

    ' Top Eject Hole 1
    Set bsHole1 = New cvpmBallStack
    With bsHole1
        .InitSaucer sw30, 30, 180, 10
        .InitExitSnd SoundFX("fx_kicker",DOFContactors), SoundFX("fx_Solenoid",DOFContactors)
        .KickForceVar = 3
        .KickAngleVar = 3
    End With

    ' Top Eject Hole 2
    Set bsHole2 = New cvpmBallStack
    With bsHole2
        .InitSaucer sw31, 31, 180, 10
        .InitExitSnd SoundFX("fx_kicker",DOFContactors), SoundFX("fx_Solenoid",DOFContactors)
        .KickForceVar = 3
        .KickAngleVar = 3
    End With

    ' Top Eject Hole 3
    Set bsHole3 = New cvpmBallStack
    With bsHole3
        .InitSaucer sw32, 32, 180, 10
        .InitExitSnd SoundFX("fx_kicker",DOFContactors), SoundFX("fx_Solenoid",DOFContactors)
        .KickForceVar = 3
        .KickAngleVar = 3
    End With

    ' Right Eject Hole
    Set bsRHole = New cvpmBallStack
    With bsRHole
        .InitSaucer sw38, 38, 180, 10
        .InitExitSnd SoundFX("fx_kicker",DOFContactors), SoundFX("fx_Solenoid",DOFContactors)
        .KickForceVar = 3
        .KickAngleVar = 3
    End With

    ' Main Timer init
    PinMAMETimer.Interval = PinMAMEInterval
    PinMAMETimer.Enabled = 1

    ' Init Bumper Rings and targets
    AliKiOff 0:RHoleoff 0
End Sub

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

'**********
' Keys
'**********

Sub table1_KeyDown(ByVal Keycode)
    If keycode = LeftTiltKey Then Nudge 90, 5:PlaySound SoundFX("fx_nudge",0), 0, 1, -0.1, 0.25
    If keycode = RightTiltKey Then Nudge 270, 5:PlaySound SoundFX("fx_nudge",0), 0, 1, 0.1, 0.25
    If keycode = CenterTiltKey Then Nudge 0, 6:PlaySound SoundFX("fx_nudge",0), 0, 1, 0, 0.25
    If keycode = PlungerKey Then PlaySoundAt "fx_PlungerPull",Plunger:Plunger.Pullback
    If keycode = 65 then DipSwitchEditor ' F7
    If vpmKeyDown(keycode) Then Exit Sub
End Sub

Sub table1_KeyUp(ByVal Keycode)
    If vpmKeyUp(keycode) Then Exit Sub
    If keycode = PlungerKey Then PlaySoundAt "fx_plunger", Plunger:Plunger.Fire
End Sub

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

' Slings & Rubbers
' Sub arubber_Hit(idx):vpmTimer.PulseSw 72:PlaySound "rubber":End Sub

Dim LStep, RStep

Sub LeftSlingShot_Slingshot
    PlaySoundAt SoundFX("fx_slingshot",DOFContactors), Lemk
    LeftSling4.Visible = 1
    Lemk.RotX = 26
    LStep = 0
    vpmTimer.PulseSw 16
    LeftSlingShot.TimerEnabled = 1
End Sub

Sub LeftSlingShot_Timer
    Select Case LStep
        Case 1:LeftSLing4.Visible = 0:LeftSLing3.Visible = 1:Lemk.RotX = 14
        Case 2:LeftSLing3.Visible = 0:LeftSLing2.Visible = 1:Lemk.RotX = 2
        Case 3:LeftSLing2.Visible = 0:Lemk.RotX = -10:LeftSlingShot.TimerEnabled = 0
    End Select

    LStep = LStep + 1
End Sub

Sub RightSlingShot_Slingshot
    PlaySoundAt SoundFX("fx_slingshot",DOFContactors), Remk
    RightSling4.Visible = 1
    Remk.RotX = 26
    RStep = 0
    vpmTimer.PulseSw 15
    RightSlingShot.TimerEnabled = 1
End Sub

Sub RightSlingShot_Timer
    Select Case RStep
        Case 1:RightSLing4.Visible = 0:RightSLing3.Visible = 1:Remk.RotX = 14
        Case 2:RightSLing3.Visible = 0:RightSLing2.Visible = 1:Remk.RotX = 2
        Case 3:RightSLing2.Visible = 0:Remk.RotX = -10:RightSlingShot.TimerEnabled = 0
    End Select

    RStep = RStep + 1
End Sub

' Bumpers
Sub LBumper_Hit:vpmTimer.PulseSw 13:PlaySoundAt SoundFX("fx_bumper",DOFContactors), LBumper:End Sub
Sub RBumper_Hit:vpmTimer.PulseSw 12:PlaySoundAt SoundFX("fx_bumper",DOFContactors), RBumper:End Sub
Sub BBumper_Hit:vpmTimer.PulseSw 14:PlaySoundAt SoundFX("fx_bumper",DOFContactors), BBumper:End Sub

' Drain & holes
Sub Drain_Hit:Playsound "drain":bsTrough.AddBall Me:End Sub
Sub sw30_Hit:bsHole1.AddBall 0:PlaySoundAt "fx_kicker-enter",sw30:End Sub
Sub sw31_Hit:bsHole2.AddBall 0:PlaySoundAt "fx_kicker-enter",sw31:End Sub
Sub sw32_Hit:bsHole3.AddBall 0:PlaySoundAt "fx_kicker-enter",sw32:End Sub
Sub sw38_Hit:bsRHole.AddBall 0:PlaySoundAt "fx_kicker-enter",sw38:End Sub

' Rollovers
Sub sw35_Hit:Controller.Switch(35) = 1:PlaySoundAt "fx_sensor", sw35:End Sub
Sub sw35_UnHit:Controller.Switch(35) = 0:End Sub

Sub sw37_Hit:Controller.Switch(37) = 1:PlaySoundAt "fx_sensor", sw37:CheckGREATEST:End Sub
Sub sw37_UnHit:Controller.Switch(37) = 0:End Sub

Sub sw36_Hit:Controller.Switch(36) = 1:PlaySoundAt "fx_sensor", sw36:CheckGREATEST:End Sub
Sub sw36_UnHit:Controller.Switch(36) = 0:End Sub

Sub sw34_Hit:Controller.Switch(34) = 1:PlaySoundAt "fx_sensor", sw34:End Sub
Sub sw34_UnHit:Controller.Switch(34) = 0:End Sub

Sub sw39_Hit:Controller.Switch(39) = 1:PlaySoundAt "fx_sensor", sw39:End Sub
Sub sw39_UnHit:Controller.Switch(39) = 0:End Sub

Sub sw5_Hit:Controller.Switch(5) = 1:PlaySoundAt "fx_sensor", sw5:CheckGREATEST:End Sub
Sub sw5_UnHit:Controller.Switch(5) = 0:End Sub

Sub sw11_Hit:Controller.Switch(11) = 1:sw11l.State = 1:PlaySoundAt "fx_sensor", sw11:End Sub
Sub sw11_UnHit:Controller.Switch(11) = 0:vpmTimer.AddTimer 250, "sw11l.State=":End Sub

Sub sw11a_Hit:Controller.Switch(11) = 1:sw11al.State = 1:PlaySoundAt "fx_sensor", sw11a:End Sub
Sub sw11a_UnHit:Controller.Switch(11) = 0:vpmTimer.AddTimer 250, "sw11al.State=":End Sub

Sub sw9_Hit:Controller.Switch(9) = 1:sw9l.State = 1:PlaySoundAt "fx_sensor", sw9:End Sub
Sub sw9_UnHit:Controller.Switch(9) = 0:vpmTimer.AddTimer 250, "sw9l.State=":End Sub

' Droptargets
Sub sw22_Dropped:dtLBank.hit 1:PlaySoundAt SoundFX("fx_droptarget",DOFDropTargets), ActiveBall:End Sub
Sub sw23_Dropped:dtLBank.hit 2:PlaySoundAt SoundFX("fx_droptarget",DOFDropTargets), ActiveBall:End Sub
Sub sw24_Dropped:dtLBank.hit 3:PlaySoundAt SoundFX("fx_droptarget",DOFDropTargets), ActiveBall:End Sub
Sub sw19_Dropped:dtTBank.hit 1:PlaySoundAt SoundFX("fx_droptarget",DOFDropTargets), ActiveBall:End Sub
Sub sw20_Dropped:dtTBank.hit 2:PlaySoundAt SoundFX("fx_droptarget",DOFDropTargets), ActiveBall:End Sub
Sub sw21_Dropped:dtTBank.hit 3:PlaySoundAt SoundFX("fx_droptarget",DOFDropTargets), ActiveBall:End Sub

' Targets
Sub sw25_Hit:vpmTimer.PulseSw 25:PlaySoundAt SoundFX("fx_target",DOFTargets), ActiveBall:CheckGREATEST:End Sub
Sub sw26_Hit:vpmTimer.PulseSw 26:PlaySoundAt SoundFX("fx_target",DOFTargets), ActiveBall:CheckGREATEST:End Sub
Sub sw27_Hit:vpmTimer.PulseSw 27:PlaySoundAt SoundFX("fx_target",DOFTargets), ActiveBall:CheckGREATEST:End Sub
Sub sw28_Hit:vpmTimer.PulseSw 28:PlaySoundAt SoundFX("fx_target",DOFTargets), ActiveBall:CheckGREATEST:End Sub
Sub sw29_Hit:vpmTimer.PulseSw 29:PlaySoundAt "fx_target", ActiveBall:CheckGREATEST:End Sub

Sub CheckGREATEST
If (l4.State + l51.State +l35.State +l19.State +l3.State +l20.State +l36.State) = 7 Then
    GiEffect
End If
End Sub

' Gates
Sub Gate1_Hit():PlaySoundAt "gate", gate1:End Sub

' Spinner
Sub Spinner1_Spin:vpmTimer.PulseSw 9:PlaySoundAt "fx_spinner", Spinner1:End Sub

'*********
'Solenoids
'*********
Solcallback(6) = "vpmsolsound SoundFX(""fx_knocker"",DOFKnocker),"
Solcallback(7) = "SolAliKickers"
SolCallback(8) = "dtTbank.SolDropUp"
SolCallback(9) = "dtLBank.SolDropUp"
Solcallback(10) = "SolRHole"
Solcallback(11) = "bsTrough.SolOut"
SolCallback(19) = "vpmNudge.SolGameOn"

Sub SolAliKickers(Enabled)
    If Enabled Then
        AliKiOn
        If bsHole1.Balls Then bsHole1.ExitSol_On
        If bsHole2.Balls Then bsHole2.ExitSol_On
        If bsHole3.Balls Then bsHole3.ExitSol_On
        vpmTimer.AddTimer 200, "AliKiOff"
    End If
End Sub

Sub AliKiOn():sw30i.IsDropped = 0:sw31i.IsDropped = 0:sw32i.IsDropped = 0:End Sub
Sub AliKiOff(dummy):sw30i.IsDropped = 1:sw31i.IsDropped = 1:sw32i.IsDropped = 1:End Sub

Sub SolRHole(Enabled)
    If Enabled Then
        sw38i.IsDropped = 0
        If bsRHole.Balls Then bsRHole.ExitSol_On
        vpmTimer.AddTimer 200, "RHoleOff"
    End If
End Sub

Sub RHoleoff(dummy):sw38i.IsDropped = 1:End Sub

'********************
'     Flippers
'********************

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

Sub SolLFlipper(Enabled)
    If Enabled Then
        PlaySound SoundFX("fx_flipperup",DOFFlippers), 0, 1, -0.1, 0.25
        LeftFlipper.RotateToEnd
    Else
        PlaySound SoundFX("fx_flipperdown",DOFFlippers), 0, 1, -0.1, 0.25
        LeftFlipper.RotateToStart
    End If
End Sub

Sub SolRFlipper(Enabled)
    If Enabled Then
        PlaySound SoundFX("fx_flipperup",DOFFlippers), 0, 1, 0.1, 0.25
        RightFlipper.RotateToEnd
    Else
        PlaySound SoundFX("fx_flipperdown",DOFFlippers), 0, 1, 0.1, 0.25
        RightFlipper.RotateToStart
    End If
End Sub

Sub LeftFlipper_Collide(parm)
    PlaySound "fx_rubber_flipper", 0, parm / 10, -0.1, 0.25
End Sub

Sub RightFlipper_Collide(parm)
    PlaySound "fx_rubber_flipper", 0, parm / 10, 0.1, 0.25
End Sub

'**************
' Extra sounds
'**************

'************************************
'          LEDs Display
'************************************

Dim Digits(28)

Set Digits(0) = a0
Set Digits(1) = a1
Set Digits(2) = a2
Set Digits(3) = a3
Set Digits(4) = a4
Set Digits(5) = a5

Set Digits(6) = b0
Set Digits(7) = b1
Set Digits(8) = b2
Set Digits(9) = b3
Set Digits(10) = b4
Set Digits(11) = b5

Set Digits(12) = c0
Set Digits(13) = c1
Set Digits(14) = c2
Set Digits(15) = c3
Set Digits(16) = c4
Set Digits(17) = c5

Set Digits(18) = d0
Set Digits(19) = d1
Set Digits(20) = d2
Set Digits(21) = d3
Set Digits(22) = d4
Set Digits(23) = d5

Set Digits(24) = e0
Set Digits(25) = e1
Set Digits(26) = e2
Set Digits(27) = e3

Sub UpdateLeds
    '    On Error Resume Next
    Dim ChgLED, num, ii, jj, chg, stat
    ChgLED = Controller.ChangedLEDs(&HFF, &HFFFF)
    If Not IsEmpty(ChgLED) Then
        For ii = 0 To UBound(ChgLED)
            num = chgLED(ii, 0):chg = chgLED(ii, 1):stat = chgLED(ii, 2)
            Select Case stat
                Case 0:Digits(num).SetValue 0    'empty
                Case 63:Digits(num).SetValue 1   '0
                Case 6:Digits(num).SetValue 2    '1
                Case 91:Digits(num).SetValue 3   '2
                Case 79:Digits(num).SetValue 4   '3
                Case 102:Digits(num).SetValue 5  '4
                Case 109:Digits(num).SetValue 6  '5
                Case 124:Digits(num).SetValue 7  '6
                Case 125:Digits(num).SetValue 7  '6
                Case 252:Digits(num).SetValue 7  '6
                Case 7:Digits(num).SetValue 8    '7
                Case 127:Digits(num).SetValue 9  '8
                Case 103:Digits(num).SetValue 10 '9
                Case 111:Digits(num).SetValue 10 '9
                Case 231:Digits(num).SetValue 10 '9
                Case 128:Digits(num).SetValue 0  'empty
                Case 191:Digits(num).SetValue 1  '0
                Case 832:Digits(num).SetValue 2  '1
                Case 896:Digits(num).SetValue 2  '1
                Case 768:Digits(num).SetValue 2  '1
                Case 134:Digits(num).SetValue 2  '1
                Case 219:Digits(num).SetValue 3  '2
                Case 207:Digits(num).SetValue 4  '3
                Case 230:Digits(num).SetValue 5  '4
                Case 237:Digits(num).SetValue 6  '5
                Case 253:Digits(num).SetValue 7  '6
                Case 135:Digits(num).SetValue 8  '7
                Case 255:Digits(num).SetValue 9  '8
                Case 239:Digits(num).SetValue 10 '9
            End Select
        Next
    End IF
End Sub

Dim OldGiState
OldGiState = -1 'start witht he Gi off

Sub GiON
    For each x in aGiLights
        x.State = 1
    Next
End Sub

Sub GiOFF
    For each x in aGiLights
        x.State = 0
    Next
End Sub

Sub GiEffect
    For each x in aGiLights
        x.Duration 2, 3000, 1
    Next
End Sub

Sub GIUpdate
    Dim tmp, obj
    tmp = Getballs
    If UBound(tmp) <> OldGiState Then
        OldGiState = Ubound(tmp)
        If UBound(tmp) = -1 Then
            GiOff
        Else
            GiOn
        End If
    End If
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), FlashRepeat(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

    UpdateLeds
    UpdateLamps
    GIUpdate
    RollingUpdate
End Sub

Sub UpdateLamps
    NFadeL 1, l1
    NFadeL 2, l2
    NFadeL 3, l3
    NFadeL 4, l4
    NFadeL 5, l5
    NFadeL 6, l6
    NFadeL 7, l7
    NFadeL 8, l8
    '9
    NFadeL 10, l10
    NFadeL 11, l11
    NFadeL 12, l12
    NFadeL 14, l14
    NFadeL 15, l15
    '16
    NFadeL 17, l17
    NFadeL 18, l18
    NFadeL 19, l19
    NFadeL 20, l20
    NFadeL 21, l21
    NFadeL 22, l22
    NFadeL 23, l23
    '24
    '25
    NFadeL 26, l26
    NFadeL 27, l27
    NFadeL 28, l28
    NFadeL 30, l30
    NFadeL 31, l31
    '32
    NFadeL 33, l33
    NFadeL 34, l34
    NFadeL 35, l35
    NFadeL 36, l36
    NFadeL 37, l37
    NFadeL 38, l38
    NFadeL 39, l39
    '40
    NFadeL 41, l41
    NFadeL 42, l42
    NFadeL 43, l43
    NFadeL 44, l44
    NFadeL 46, l46
    NFadeL 47, l47
    '48
    NFadeL 49, l49
    NFadeL 50, l50
    NFadeL 51, l51
    '52
    NFadeL 53, l53
    NFadeL 54, l54
    NFadeL 55, l55
    '56
    NFadeL 57, l57
    NFadeL 58, l58
    NFadeL 59, l59
    NFadeL 60, l60
    NFadeL 62, l62

' backdrop lights
If VarHidden Then
    NFadeT 13, l13, "Highscore"
    NFadeT 29, l29, "Ball in Play"
    NFadeT 45, l45, "Game Over"
    NFadeT 61, l61, "Tilt"
    NFadeT 63, l63, "Match"
End If
End Sub

' div lamp subs

Sub InitLamps()
  Dim x
  For x = 0 to 200
    LampState(x) = 0        ' current light state, independent of the fading level. 0 is off and 1 is on
    FadingLevel(x) = 4      ' used to track the fading state
    FlashSpeedUp(x) = 0.2   ' faster speed when turning on the flasher
    FlashSpeedDown(x) = 0.1 ' 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
    FlashRepeat(x) = 20     ' how many times the flash repeats
  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 doesn't change anything, it just follows the main flasher
  Select Case FadingLevel(nr)
    Case 4, 5
      Object.IntensityScale = FlashLevel(nr)
  End Select
End Sub

Sub FlashBlink(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)
      If FadingLevel(nr) = 0 AND FlashRepeat(nr) Then 'repeat the flash
        FlashRepeat(nr) = FlashRepeat(nr) -1
        If FlashRepeat(nr) Then FadingLevel(nr) = 5
        End If
      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)
        If FadingLevel(nr) = 1 AND FlashRepeat(nr) Then FadingLevel(nr) = 4
  End Select
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

'******************************
' Diverse Collection Hit Sounds
'******************************

Sub aMetals_Hit(idx):PlaySound "fx_MetalHit", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall):End Sub
Sub aRubber_Bands_Hit(idx):PlaySound "fx_rubber_band", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall):End Sub
Sub aRubber_Posts_Hit(idx):PlaySound "fx_rubber", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall): End Sub
Sub aRubber_Pins_Hit(idx):PlaySound "fx_postrubber", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall):End Sub
Sub aPlastics_Hit(idx):PlaySound "fx_PlasticHit", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall):End Sub
Sub aGates_Hit(idx):PlaySound "fx_Gate", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall):End Sub
Sub aWoods_Hit(idx):PlaySound "fx_Woodhit", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall):End Sub

'*******************************
' Dipswitches from the old table
'*******************************

Dim saveDips
saveDips = Array(191, 255, 7, 63)

Sub DipSwitchEditor()
  dim vpmDips, i, settings(3)

  'Save the settings I don't have code for
  for i = 0 to 3
    settings(i) = Controller.dip(i) and saveDips(i)
  next

  on error resume next
  set vpmDips = new cvpmDips
  with vpmDips
    .AddForm 315, 250, "ALI DIP Switch Settings"
    .AddFrame 2, 10, 140, "Balls per game", &H00000040,           _
    Array("3", 0, "5", &H00000040)

    .AddFrame 160, 10, 140, "GREATEST + ALI scores", &HC0000000,  _
    Array("Jack", 0, "Score", &H40000000,                     _
    "Extra Ball", &H80000000, "Special", &HC0000000)

    .AddFrame 2, 90, 140, "Specials per ball", &H00200000,        _
    Array("One", 0, "Unlimited", &H00200000)

    .AddFrame 160, 90, 140, "Specials", &H00400000,               _
    Array("Alternate", 0, "All light", &H00400000)

    .AddFrame 2, 140, 140, "GREATEST lights Special", &H00800000, _
    Array("2nd time", 0, "1st time", &H00800000)

    .AddChk 7, 200, 148, Array("Credit display", &H00080000)
    .AddChk 160, 200, 148, Array("Match", &H00100000)
    .AddLabel 7, 230, 300, 20, "After hitting OK, press F3 to reset game with new settings."
    .ViewDips
  end with
  if Err then DipSwitchDisplayError
    on error goto 0
    'Restore non-coded settings
    for i = 0 to 3
      Controller.dip(i) = settings(i) or((255-saveDips(i) ) and Controller.dip(i) )
    next
End Sub

Sub DipSwitchDisplayError()
  MsgBox "Can't display dip switch editor." & vbCRLF & vbCRLF &           _
  "Be sure you have wshLtWtForm.ocx loaded and registered" & vbCRLF & _
  "and vbs scripts 3.02 or higher." & vbCRLF & vbCRLF &               _
  "You may want to hit F6 to edit the switches manually."
End Sub

' *******************************************************************************************************
' Positional Sound Playback Functions by DJRobX
' PlaySound sound, 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 0, 1, AudioFade(ActiveBall)
' *******************************************************************************************************

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

Sub PlayXYSound(soundname, tableobj, loopcount, volume, randompitch, pitch, useexisting, restart)
  PlaySound soundname, loopcount, volume, AudioPan(tableobj), randompitch, pitch, useexisting, restart, AudioFade(tableobj)
End Sub

' Set position as table object (Use object or light but NOT wall) and Vol to 1

Sub PlaySoundAt(soundname, tableobj)
  PlaySound soundname, 1, 1, AudioPan(tableobj), 0,0,0, 1, AudioFade(tableobj)
End Sub

'Set all as per ball position & speed.

Sub PlaySoundAtBall(soundname)
  PlaySoundAt soundname, ActiveBall
End Sub

'Set position as table object and Vol manually.

Sub PlaySoundAtVol(sound, tableobj, Vol)
  PlaySound sound, 1, Vol, Pan(tableobj), 0,0,0, 1, AudioFade(tableobj)
End Sub

'Set all as per ball position & speed, but Vol Multiplier may be used eg; PlaySoundAtBallVol "sound",3

Sub PlaySoundAtBallVol(sound, VolMult)
  PlaySound sound, 0, Vol(ActiveBall) * VolMult, Pan(ActiveBall), 0, Pitch(ActiveBall), 0, 1, AudioFade(ActiveBall)
End Sub

'Set position as bumperX and Vol manually.

Sub PlaySoundAtBumperVol(sound, tableobj, Vol)
  PlaySound sound, 1, Vol, Pan(tableobj), 0,0,1, 1, AudioFade(tableobj)
End Sub

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

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

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

Function 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 AudioFade(ball) ' Can this be together with the above function ?
  Dim tmp
  tmp = ball.y * 2 / Table1.height-1
  If tmp > 0 Then
    AudioFade = Csng(tmp ^10)
  Else
    AudioFade = Csng(-((- tmp) ^10) )
  End If
End Function

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

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

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

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

Const tnob = 5 ' total number of balls in this table is 4, but always use a higher number here because of the timing
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

    ' play the rolling sound for each ball
    For b = 0 to UBound(BOT)
      If BallVel(BOT(b) ) > 1 Then
        rolling(b) = True
        if BOT(b).z < 30 Then ' Ball on playfield
          PlaySound("fx_ballrolling" & b), -1, Vol(BOT(b) ), Pan(BOT(b) ), 0, Pitch(BOT(b) ), 1, 0, AudioFade(BOT(b) )
        Else ' Ball on raised ramp
          PlaySound("fx_ballrolling" & b), -1, Vol(BOT(b) )*.5, Pan(BOT(b) ), 0, Pitch(BOT(b) )+50000, 1, 0, AudioFade(BOT(b) )
        End If
      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)
  If Table1.VersionMinor > 3 OR Table1.VersionMajor > 10 Then
    PlaySound("fx_collide"), 0, Csng(velocity) ^2 / 200, Pan(ball1), 0, Pitch(ball1), 0, 0, AudioFade(ball1)
  Else
    PlaySound("fx_collide"), 0, Csng(velocity) ^2 / 200, Pan(ball1), 0, Pitch(ball1), 0, 0
  End if
End Sub


' Thalamus : Exit in a clean and proper way
Sub Table1_exit()
  Controller.Pause = False
  Controller.Stop
End Sub