Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Option Explicit
- Randomize
- On Error Resume Next
- ExecuteGlobal GetTextFile("controller.vbs")
- If Err Then MsgBox "You need the controller.vbs in order to run this table, available in the vp10 package"
- On Error Goto 0
- Const cGameName="cueball",UseSolenoids=1,UseLamps=0,UseGI=0,SSolenoidOn="SolOn",SSolenoidOff="SolOff", SCoin="coin"
- Const BallSize = 54
- LoadVPM "01570000", "gts3.vbs", 3.26
- Dim DesktopMode: DesktopMode = Table1.ShowDT
- If DesktopMode = True Then 'Show Desktop components
- Ramp16.visible=1
- Ramp15.visible=1
- Primitive13.visible=1
- Else
- Ramp16.visible=0
- Ramp15.visible=0
- Primitive13.visible=0
- End if
- '*************************************************************
- 'Solenoid Call backs
- '**********************************************************************************************************
- SolCallback(8) = "Solgate"
- SolCallback(9) = "dtRBank.SolDropUp"
- SolCallback(10) = "SolShoot8Ball"
- SolCallback(11) = "bsBSaucer.SolOut"
- SolCallback(12) = "dtLBank.SolDropUp"
- SolCallback(13) = "bsLSaucer.SolOut"
- SolCallback(14) = "bsRSaucer.SolOut"
- SolCallback(15) = "SetLamp 151,"
- SolCallback(16) = "SetLamp 152,"
- SolCallback(17) = "SetLamp 153,"
- SolCallback(18) = "SetLamp 154,"
- SolCallback(19) = "SetLamp 155,"
- SolCallback(21) = "SetLamp 156,"
- SolCallback(22) = "SetLamp 157,"
- SolCallback(28) = "bsTrough.SolOut"
- 'SolCallback(25) = "shootermotor"
- SolCallback(29) = "bsTrough.SolIn"
- SolCallback(30) = "vpmSolSound SoundFX(""Knocker"",DOFKnocker),"
- SolCallback(sLRFlipper) = "SolRFlipper"
- SolCallback(sLLFlipper) = "SolLFlipper"
- Sub SolLFlipper(Enabled)
- If Enabled Then
- PlaySound SoundFX("fx_Flipperup",DOFContactors):LeftFlipper.RotateToEnd
- Else
- PlaySound SoundFX("fx_Flipperdown",DOFContactors):LeftFlipper.RotateToStart
- End If
- End Sub
- Sub SolRFlipper(Enabled)
- If Enabled Then
- PlaySound SoundFX("fx_Flipperup",DOFContactors):RightFlipper.RotateToEnd
- Else
- PlaySound SoundFX("fx_Flipperdown",DOFContactors):RightFlipper.RotateToStart
- End If
- End Sub
- '**********************************************************************************************************
- 'Solenoid Controlled toys
- '**********************************************************************************************************
- Sub Solgate(Enabled)
- If Enabled Then
- PlungerGate.IsDropped=1
- PlungerGate1.Enabled= 0
- PlungerGate1.kick 0,0
- PlaySound SoundFX("fx_Flipperup",DOFContactors)
- Else
- PlungerGate.IsDropped=0
- PlungerGate1.Enabled= 1
- End If
- End Sub
- '*****GI Lights On
- dim xx
- For each xx in GI:xx.State = 1: Next
- '**********************************************************************************************************
- 'Initiate Table
- '**********************************************************************************************************
- Dim bsTrough, dtLBank, dtRBank, mShooter, bsLSaucer, bsRSaucer, bsBSaucer
- Sub Table1_Init
- vpmInit Me
- On Error Resume Next
- With Controller
- .GameName = cGameName
- If Err Then MsgBox "Can't start Game" & cGameName & vbNewLine & Err.Description : Exit Sub
- .SplashInfoLine = ""&chr(13)&"You Suck"
- .HandleMechanics=0
- .HandleKeyboard=0
- .ShowDMDOnly=1
- .ShowFrame=0
- .ShowTitle=0
- .hidden = 0
- On Error Resume Next
- .Run GetPlayerHWnd
- If Err Then MsgBox Err.Description
- On Error Goto 0
- End With
- On Error Goto 0
- PinMAMETimer.Interval=PinMAMEInterval
- PinMAMETimer.Enabled=1
- vpmNudge.TiltSwitch = 151
- vpmNudge.Sensitivity = 2
- vpmNudge.TiltObj = Array(Bumper1, Bumper2, LeftSlingshot, RightSlingshot)
- ' Trough
- Set bsTrough = New cvpmBallStack
- bsTrough.InitSw 40, 41, 0, 0, 0, 0, 0, 0
- bsTrough.InitKick BallRelease, 80, 6
- bsTrough.InitExitSnd SoundFX("ballrelease",DOFContactors), SoundFX("Solenoid",DOFContactors)
- bsTrough.Balls = 3
- Set bsLSaucer = New cvpmBallStack
- bsLSaucer.InitSaucer sw27, 27, 225, 11
- bsLSaucer.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)
- bsLSaucer.KickAngleVar = 2
- Set bsRSaucer = New cvpmBallStack
- bsRSaucer.InitSaucer sw37, 37, 145, 11
- bsRSaucer.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)
- bsRSaucer.KickAngleVar = 2
- Set bsBSaucer = New cvpmBallStack
- bsBSaucer.InitSaucer sw17, 17, 134, 19
- bsBSaucer.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)
- bsBSaucer.KickAngleVar = 2
- set dtLBank = new cvpmdroptarget
- dtLBank.initdrop array(sw20, sw30, sw21, sw31, sw22, sw32, sw26), array(20, 30, 21, 31, 22, 32, 26)
- dtLBank.initsnd SoundFX("DTDrop",DOFContactors),SoundFX("DTReset",DOFContactors)
- dtLBank.CreateEvents "dtLBank"
- set dtRBank = new cvpmdroptarget
- dtRBank.initdrop array(sw23, sw33, sw24, sw34, sw25, sw35, sw36), array(23, 33, 24, 34, 25, 35, 36)
- dtRBank.initsnd SoundFX("DTDrop",DOFContactors),SoundFX("DTReset",DOFContactors)
- dtRBank.CreateEvents "dtRBank"
- Set mShooter = New cvpmMech
- With mShooter
- .MType = vpmMechOneSol + vpmMechReverse + vpmMechLinear
- .Sol1 = 25
- .Length = 80
- .Steps = 9
- .Callback = GetRef("UpdateShooter")
- .Start
- End With
- CreateBlackBall
- CreateWhiteBall
- End Sub
- Sub Table1_Paused:Controller.Pause = 1:End Sub
- Sub Table1_unPaused:Controller.Pause = 0:End Sub
- '**********************************************************************************************************
- 'Plunger code
- '**********************************************************************************************************
- Sub Table1_KeyDown(ByVal Keycode)
- If keycode = LeftFlipperKey Then Controller.Switch(81) = 1
- If keycode = RightFlipperKey Then Controller.Switch(82) = 1
- If keycode = StartGameKey Then Controller.Switch(4) = 1
- If keycode = PlungerKey Then Plunger.Pullback:playsound"plungerpull"
- If vpmKeyDown(keycode) Then Exit Sub
- End Sub
- Sub Table1_KeyUp(ByVal Keycode)
- If keycode = LeftFlipperKey Then Controller.Switch(81) = 0
- If keycode = RightFlipperKey Then Controller.Switch(82) = 0
- If keycode = StartGameKey Then Controller.Switch(4) = 0
- If keycode = PlungerKey Then Plunger.Fire:PlaySound"plunger"
- If vpmKeyUp(keycode) Then Exit Sub
- End Sub
- '**********************************************************************************************************
- ' Drain & Holes
- Sub Drain_Hit:bsTrough.addball me : playsound"drain" : End Sub
- Sub Drain2_Hit:bsTrough.addball me : playsound"drain" : End Sub
- Sub Drain3_Hit:bsTrough.addball me : playsound"drain" : End Sub
- Sub Drain4_Hit:bsTrough.addball me : playsound"drain" : End Sub
- Sub sw17_Hit:bsBSaucer.AddBall 0 : playsound "popper_ball": End Sub
- Sub sw27_Hit:bsLSaucer.AddBall 0 : playsound "popper_ball": End Sub
- Sub sw37_Hit:bsRSaucer.AddBall 0 : playsound "popper_ball": End Sub
- 'wire triggers
- Sub sw7_Hit:Controller.Switch(7) = 1 : playsound"rollover" : End Sub
- Sub sw7_UnHit:Controller.Switch(7) = 0:End Sub
- Sub sw91_Hit:Controller.Switch(91) = 1 : playsound"rollover" : End Sub
- Sub sw91_UnHit:Controller.Switch(91) = 0:End Sub
- Sub sw92_Hit:Controller.Switch(92) = 1 : playsound"rollover" : End Sub
- Sub sw92_UnHit:Controller.Switch(92) = 0:End Sub
- Sub sw101_Hit:Controller.Switch(101) = 1 : playsound"rollover" : End Sub
- Sub sw101_UnHit:Controller.Switch(101) = 0:End Sub
- Sub sw102_Hit:Controller.Switch(102) = 1 : playsound"rollover" : End Sub
- Sub sw102_UnHit:Controller.Switch(102) = 0:End Sub
- 'Scoring Rubbers
- Sub sw12_Slingshot:vpmTimer.PulseSw 12 : playsound"flip_hit_3" : End Sub
- Sub sw13_SlingShot:vpmTimer.PulseSw 13 : playsound"flip_hit_3" : End Sub
- ' Bumpers
- Sub Bumper1_Hit:vpmTimer.PulseSw 10 : playsound SoundFX("fx_bumper1",DOFContactors): End Sub
- Sub Bumper2_Hit:vpmTimer.PulseSw 11 : playsound SoundFX("fx_bumper1",DOFContactors): End Sub
- ' Targets
- Sub sw16_Hit:vpmTimer.PulseSw 16::Me.TimerEnabled = 1:PlaySound "target":End Sub
- Sub sw16_Timer::Me.TimerEnabled = 0:End Sub
- Sub sw93_Hit:vpmTimer.PulseSw 93:End Sub
- Sub sw930_Hit:vpmTimer.PulseSw 93:End Sub
- Sub sw94_Hit:vpmTimer.PulseSw 94:End Sub
- Sub sw95_Hit:vpmTimer.PulseSw 95:End Sub
- Sub sw950_Hit:vpmTimer.PulseSw 95:End Sub
- Sub sw96_Hit:vpmTimer.PulseSw 96:End Sub
- Sub sw97_Hit:vpmTimer.PulseSw 97:End Sub
- Sub sw970_Hit:vpmTimer.PulseSw 97:End Sub
- Sub sw103_Hit:vpmTimer.PulseSw 103:End Sub
- Sub sw1030_Hit:vpmTimer.PulseSw 103:End Sub
- Sub sw111_Hit:vpmTimer.PulseSw 111:End Sub
- Sub sw112_Hit:vpmTimer.PulseSw 112:End Sub
- Sub sw1120_Hit:vpmTimer.PulseSw 112:End Sub
- Sub sw113_Hit:vpmTimer.PulseSw 113:End Sub
- Sub sw114_Hit:vpmTimer.PulseSw 114:End Sub
- Sub sw1140_Hit:vpmTimer.PulseSw 114:End Sub
- Sub sw115_Hit:vpmTimer.PulseSw 115:End Sub
- Sub sw116_Hit:vpmTimer.PulseSw 116:End Sub
- Sub sw1160_Hit:vpmTimer.PulseSw 116:End Sub
- Sub sw117_Hit:vpmTimer.PulseSw 117:End Sub
- Sub sw1170_Hit:vpmTimer.PulseSw 117:End Sub
- 'Ramp Triggers
- Sub sw80_Hit:Controller.Switch(80) = 1:PlaySound "Wire Ramp":End Sub
- Sub sw80_UnHit:Controller.Switch(80) = 0:End Sub
- Sub sw90_Hit:Controller.Switch(90) = 1:End Sub
- Sub sw90_UnHit:Controller.Switch(90) = 0:End Sub
- ' Opto Sensors
- Sub sw100_Hit:Controller.Switch(100) = 1:End Sub
- Sub sw100_UnHit:Controller.Switch(100) = 0:End Sub
- Sub sw110_Hit:Controller.Switch(110) = 1:End Sub
- Sub sw110_UnHit:Controller.Switch(110) = 0:End Sub
- 'Generic Sounds
- Sub Trigger1_Hit:PlaySound "fx_ballrampdrop":StopSound "Wire Ramp":End Sub
- Sub Trigger2_Hit:StopSound "Wire Ramp":End Sub
- Sub Trigger3_Hit:PlaySound "Wire Ramp":End Sub
- ' **************
- ' White Ball
- ' **************
- Dim WBall
- Sub CreateWhiteBall()
- Set WBall = kicker9.Createsizedball(55):WBall.Image = "CBallW":kicker9.Kick 0, 0
- WBall.X = 464
- WBall.Y = 1022
- 'WBall.CollisionMass = 1.7
- End Sub
- Sub kicker9_UnHit() NewBallid:End Sub
- Sub CaptiveHelp1_Hit
- If ActiveBall is WBall Then
- With ActiveBall
- .VelX = -.VelX / 3: .VelY = -.VelY / 3
- End With
- sw103_Hit
- End If
- End Sub
- Sub CaptiveHelp2_Hit
- If ActiveBall is WBall Then
- With ActiveBall
- .VelX = -.VelX / 3: .VelY = -.VelY / 3
- End With
- sw1030_Hit
- End If
- End Sub
- ' **************
- ' Black Ball
- ' **************
- Dim Bball
- Sub CreateBlackBall()
- Set BBall = kicker10.Createsizedball(55)
- BBall.Image = "CBallB"
- 'BBall.CollisionMass = 1.7
- kicker10.Kick 0, 0
- End Sub
- '************************
- ' 8 Ball Platform Update
- '************************
- ' Init 8 Ball Shooter Platform
- Dim ShooterWalls1, ShooterWalls2, ShooterWalls3, ShooterPos, BallInShooter
- ShooterWalls1 = Array(pl11, pl21, pl31, pl41, pl51, pl61, pl71, pl81, pl91, pl91)
- ShooterWalls2 = Array(pl12, pl22, pl32, pl42, pl52, pl62, pl72, pl82, pl92, pl92)
- ShooterWalls3 = Array(pl13, pl23, pl33, pl43, pl53, pl63, pl73, pl83, pl93, pl93)
- vpmSolWall ShooterWalls1, 0, 1
- vpmSolWall ShooterWalls2, 0, 1
- vpmSolWall ShooterWalls3, 0, 1
- Sub UpdateShooter(aNewPos, aSpeed, aLastPos)
- ShooterWalls1(aLastPos).IsDropped = 1
- ShooterWalls2(aLastPos).IsDropped = 1
- ShooterWalls3(aLastPos).IsDropped = 1
- ShooterWalls1(aNewPos).IsDropped = 0
- ShooterWalls2(aNewPos).IsDropped = 0
- ShooterWalls3(aNewPos).IsDropped = 0
- ShooterPos = aNewPos
- CheckBallInShooter
- End Sub
- Sub SolShoot8Ball(Enabled)
- If Enabled AND BallInShooter Then
- Select Case ShooterPos
- Case 0:BBall.VelX = -8
- Case 1:BBall.VelX = -6
- Case 2:BBall.VelX = -4
- Case 3:BBall.VelX = -2
- Case 4:BBall.VelX = 0
- Case 5:BBall.VelX = 0
- Case 6:BBall.VelX = 2
- Case 7:BBall.VelX = 4
- Case 8:BBall.VelX = 6
- Case 9:BBall.VelX = 8
- End Select
- playsound SoundFX("Popper",DOFContactors)
- BBall.VelY = 85
- End If
- End Sub
- Sub SwShooter_Hit:BallInShooter = 1:End Sub
- Sub SwShooter_UnHit:BallInShooter = 0:End Sub
- Sub CheckBallInShooter
- If BallInShooter Then
- Select Case ShooterPos
- Case 0:BBall.X = 432
- Case 1:BBall.X = 442
- Case 2:BBall.X = 452
- Case 3:BBall.X = 462
- Case 4:BBall.X = 472
- Case 5:BBall.X = 482
- Case 6:BBall.X = 492
- Case 7:BBall.X = 502
- Case 8:BBall.X = 512
- Case 9:BBall.X = 512
- End Select
- 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)
- InitLamps() ' turn off the lights and flashers and reset them to the default parameters
- LampTimer.Interval = 5 'lamp fading speed
- LampTimer.Enabled = 1
- ' Lamp & Flasher Timers
- Sub LampTimer_Timer()
- Dim chgLamp, num, chg, ii
- chgLamp = Controller.ChangedLamps
- If Not IsEmpty(chgLamp) Then
- For ii = 0 To UBound(chgLamp)
- LampState(chgLamp(ii, 0) ) = chgLamp(ii, 1) 'keep the real state in an array
- FadingLevel(chgLamp(ii, 0) ) = chgLamp(ii, 1) + 4 'actual fading step
- 'Special Handling
- 'If chgLamp(ii,0) = 2 Then solTrough chgLamp(ii,1)
- 'If chgLamp(ii,0) = 4 Then PFGI chgLamp(ii,1)
- Next
- End If
- UpdateLamps
- End Sub
- Sub UpdateLamps()
- NFadeL 0, l0
- NFadeObjm 2, p2, "bulbcover1_greenON", "bulbcover1_green"
- NFadeL 2, l2 'Apron LED
- NFadeObjm 3, p3, "bulbcover1_greenON", "bulbcover1_green"
- NFadeL 3, l3 'Apron LED
- NFadeObjm 4, p4, "bulbcover1_greenON", "bulbcover1_green"
- NFadeL 4, l4 'Apron LED
- NFadeObjm 5, p5, "bulbcover1_greenON", "bulbcover1_green"
- NFadeL 5, l5 'Apron LED
- NFadeObjm 6, p6, "bulbcover1_greenON", "bulbcover1_green"
- NFadeL 6, l6 'Apron LED
- NFadeObjm 7, p7, "bulbcover1_greenON", "bulbcover1_green"
- NFadeL 7, l7 'Apron LED
- NFadeL 10, L10 'Bumper 1
- NFadeL 10, L10a 'Bumper 1
- NFadeL 11, L11 'Bumper 2
- NFadeL 11, L11a 'Bumper 2
- NFadeObjm 12, p12, "bulbcover1_redON", "bulbcover1_red"
- NFadeL 12, l12 'Apron LED
- NFadeObjm 13, p13, "bulbcover1_redON", "bulbcover1_red"
- NFadeL 13, l13 'Apron LED
- NFadeObjm 14, p14, "bulbcover1_redON", "bulbcover1_red"
- NFadeL 14, l14 'Apron LED
- NFadeObjm 15, p15, "bulbcover1_redON", "bulbcover1_red"
- NFadeL 15, l15 'Apron LED
- NFadeObjm 16, p16, "bulbcover1_redON", "bulbcover1_red"
- NFadeL 16, l16 'Apron LED
- NFadeObjm 17, p17, "bulbcover1_redON", "bulbcover1_red"
- NFadeL 17, l17 'Apron LED
- 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 30, l30
- NFadeL 31, l31
- NFadeL 32, l32
- NFadeL 33, l33
- NFadeL 34, l34
- NFadeL 35, l35
- NFadeL 36, l36
- NFadeL 37, l37
- 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 50, l50
- NFadeL 51, l51
- NFadeL 52, l52
- NFadeL 53, l53
- NFadeL 54, l54
- NFadeL 55, l55
- NFadeL 56, l56
- NFadeL 57, l57
- NFadeL 60, l60
- NFadeL 61, l61
- NFadeL 62, l62
- NFadeL 63, l63
- NFadeL 64, l64
- NFadeL 65, l65
- NFadeL 66, l66
- NFadeL 67, l67
- NFadeL 70, l70
- NFadeL 71, l71
- NFadeL 72, l72
- NFadeL 73, l73
- NFadeL 74, l74
- NFadeL 75, l75
- NFadeL 76, l76
- NFadeL 77, l77
- NFadeL 80, l80
- NFadeL 81, l81
- NFadeL 82, l82
- NFadeL 83, l83
- NFadeL 84, l84
- NFadeL 85, l85
- NFadeL 86, l86
- NFadeL 87, l87
- NFadeObjm 90, p90, "bulbcover1_redON", "bulbcover1_red"
- Flash 90, F90 'LED
- NFadeObjm 91, p91, "bulbcover1_redON", "bulbcover1_red"
- Flash 91, F91 'LED
- NFadeL 92, l92
- NFadeL 93, l93
- NFadeL 94, l94
- NFadeL 95, l95
- NFadeL 96, l96
- NFadeL 97, l97
- NFadeL 100, l100
- NFadeL 101, l101
- NFadeL 102, l102
- NFadeL 103, l103
- NFadeL 104, l104
- NFadeL 105, l105
- NFadeL 106, l106
- NFadeL 107, l107
- NFadeL 110, l110
- NFadeL 111, l111
- NFadeL 112, l112
- NFadeL 113, l113
- NFadeL 114, l114
- NFadeL 115, l115
- NFadeL 116, l116
- NFadeL 117, l117
- ' Solenoid Controlled
- NFadeObjm 151, p151a, "dome2_0_clearON", "dome2_0_clear" 'Dome
- NFadeObjm 151, p151b, "dome2_0_clearON", "dome2_0_clear" 'Dome
- NFadeObjm 151, p151c, "dome2_0_clearON", "dome2_0_clear" 'Dome
- NFadeObjm 151, p151d, "dome2_0_clearON", "dome2_0_clear" 'Dome
- Flashm 151, f151a
- Flashm 151, f151b
- Flashm 151, f151c
- Flash 151, f151d
- NFadeObjm 152, p152a, "dome2_0_clearON", "dome2_0_clear" 'Dome
- NFadeObjm 152, p152b, "dome2_0_clearON", "dome2_0_clear" 'Dome
- NFadeObjm 152, p152c, "dome2_0_clearON", "dome2_0_clear" 'Dome
- NFadeObjm 152, p152d, "dome2_0_clearON", "dome2_0_clear" 'Dome
- Flashm 152, f152a
- Flashm 152, f152b
- Flashm 152, f152c
- Flash 152, f152d
- NFadeObjm 153, P153, "dome2_0_yellowON", "dome2_0_yellow" 'Dome
- Flash 153, f153
- NFadeObjm 154, P154, "dome2_0_blueON", "dome2_0_blue" 'Dome
- Flash 154, f154
- NFadeObjm 155, P155, "dome2_0_redON", "dome2_0_red" 'Dome
- Flash 155, f155
- NFadeObjm 156, f156, "dome2_0_clearON", "dome2_0_clear" 'Dome
- NFadeL 156, F156
- NFadeObjm 157, P157, "dome2_0_clearON", "dome2_0_clear" 'Dome
- NFadeL 157, F157
- End Sub
- ' div lamp subs
- Sub InitLamps()
- Dim x
- For x = 0 to 200
- LampState(x) = 0 ' current light state, independent of the fading level. 0 is off and 1 is on
- FadingLevel(x) = 4 ' used to track the fading state
- FlashSpeedUp(x) = 0.4 ' faster speed when turning on the flasher
- FlashSpeedDown(x) = 0.2 ' slower speed when turning off the flasher
- FlashMax(x) = 1 ' the maximum value when on, usually 1
- FlashMin(x) = 0 ' the minimum value when off, usually 0
- FlashLevel(x) = 0 ' the intensity of the flashers, usually from 0 to 1
- Next
- End Sub
- Sub AllLampsOff
- Dim x
- For x = 0 to 200
- SetLamp x, 0
- Next
- End Sub
- Sub SetLamp(nr, value)
- If value <> LampState(nr) Then
- LampState(nr) = abs(value)
- FadingLevel(nr) = abs(value) + 4
- End If
- End Sub
- ' Lights: used for VP10 standard lights, the fading is handled by VP itself
- Sub NFadeL(nr, object)
- Select Case FadingLevel(nr)
- Case 4:object.state = 0:FadingLevel(nr) = 0
- Case 5:object.state = 1:FadingLevel(nr) = 1
- End Select
- End Sub
- Sub NFadeLm(nr, object) ' used for multiple lights
- Select Case FadingLevel(nr)
- Case 4:object.state = 0
- Case 5:object.state = 1
- End Select
- End Sub
- 'Lights, Ramps & Primitives used as 4 step fading lights
- 'a,b,c,d are the images used from on to off
- Sub FadeObj(nr, object, a, b, c, d)
- Select Case FadingLevel(nr)
- Case 4:object.image = b:FadingLevel(nr) = 6 'fading to off...
- Case 5:object.image = a:FadingLevel(nr) = 1 'ON
- Case 6, 7, 8:FadingLevel(nr) = FadingLevel(nr) + 1 'wait
- Case 9:object.image = c:FadingLevel(nr) = FadingLevel(nr) + 1 'fading...
- Case 10, 11, 12:FadingLevel(nr) = FadingLevel(nr) + 1 'wait
- Case 13:object.image = d:FadingLevel(nr) = 0 'Off
- End Select
- End Sub
- Sub FadeObjm(nr, object, a, b, c, d)
- Select Case FadingLevel(nr)
- Case 4:object.image = b
- Case 5:object.image = a
- Case 9:object.image = c
- Case 13:object.image = d
- End Select
- End Sub
- Sub NFadeObj(nr, object, a, b)
- Select Case FadingLevel(nr)
- Case 4:object.image = b:FadingLevel(nr) = 0 'off
- Case 5:object.image = a:FadingLevel(nr) = 1 'on
- End Select
- End Sub
- Sub NFadeObjm(nr, object, a, b)
- Select Case FadingLevel(nr)
- Case 4:object.image = b
- Case 5:object.image = a
- End Select
- End Sub
- ' Flasher objects
- Sub Flash(nr, object)
- Select Case FadingLevel(nr)
- Case 4 'off
- FlashLevel(nr) = FlashLevel(nr) - FlashSpeedDown(nr)
- If FlashLevel(nr) < FlashMin(nr) Then
- FlashLevel(nr) = FlashMin(nr)
- FadingLevel(nr) = 0 'completely off
- End if
- Object.IntensityScale = FlashLevel(nr)
- Case 5 ' on
- FlashLevel(nr) = FlashLevel(nr) + FlashSpeedUp(nr)
- If FlashLevel(nr) > FlashMax(nr) Then
- FlashLevel(nr) = FlashMax(nr)
- FadingLevel(nr) = 1 'completely on
- End if
- Object.IntensityScale = FlashLevel(nr)
- End Select
- End Sub
- Sub Flashm(nr, object) 'multiple flashers, it just sets the flashlevel
- Object.IntensityScale = FlashLevel(nr)
- End Sub
- '**********Sling Shot Animations
- ' Rstep and Lstep are the variables that increment the animation
- '****************
- Dim RStep, Lstep
- Sub RightSlingShot_Slingshot
- vpmTimer.PulseSw 15
- PlaySound SoundFX("right_slingshot",DOFContactors), 0,1, 0.05,0.05 '0,1, AudioPan(RightSlingShot), 0.05,0,0,1,AudioFade(RightSlingShot)
- RSling.Visible = 0
- RSling1.Visible = 1
- sling1.rotx = 20
- RStep = 0
- RightSlingShot.TimerEnabled = 1
- End Sub
- Sub RightSlingShot_Timer
- Select Case RStep
- Case 3:RSLing1.Visible = 0:RSLing2.Visible = 1:sling1.rotx = 10
- Case 4:RSLing2.Visible = 0:RSLing.Visible = 1:sling1.rotx = 0:RightSlingShot.TimerEnabled = 0
- End Select
- RStep = RStep + 1
- End Sub
- Sub LeftSlingShot_Slingshot
- vpmTimer.PulseSw 14
- PlaySound SoundFX("left_slingshot",DOFContactors), 0,1, -0.05,0.05 '0,1, AudioPan(LeftSlingShot), 0.05,0,0,1,AudioFade(LeftSlingShot)
- LSling.Visible = 0
- LSling1.Visible = 1
- sling2.rotx = 20
- LStep = 0
- LeftSlingShot.TimerEnabled = 1
- End Sub
- Sub LeftSlingShot_Timer
- Select Case LStep
- Case 3:LSLing1.Visible = 0:LSLing2.Visible = 1:sling2.rotx = 10
- Case 4:LSLing2.Visible = 0:LSLing.Visible = 1:sling2.rotx = 0:LeftSlingShot.TimerEnabled = 0
- End Select
- LStep = LStep + 1
- End Sub
- '*********************************************************************
- ' Positional Sound Playback Functions
- '*********************************************************************
- ' Play a sound, depending on the X,Y position of the table element (especially cool for surround speaker setups, otherwise stereo panning only)
- ' parameters (defaults): loopcount (1), volume (1), randompitch (0), pitch (0), useexisting (0), restart (1))
- ' Note that this will not work (currently) for walls/slingshots as these do not feature a simple, single X,Y position
- Sub PlayXYSound(soundname, tableobj, loopcount, volume, randompitch, pitch, useexisting, restart)
- PlaySound soundname, loopcount, volume, AudioPan(tableobj), randompitch, pitch, useexisting, restart, AudioFade(tableobj)
- End Sub
- ' Similar subroutines that are less complicated to use (e.g. simply use standard parameters for the PlaySound call)
- Sub PlaySoundAt(soundname, tableobj)
- PlaySound soundname, 1, 1, AudioPan(tableobj), 0,0,0, 1, AudioFade(tableobj)
- End Sub
- Sub PlaySoundAtBall(soundname)
- PlaySoundAt soundname, ActiveBall
- End Sub
- '*********************************************************************
- ' Supporting Ball & Sound Functions
- '*********************************************************************
- Function AudioFade(tableobj) ' Fades between front and back of the table (for surround systems or 2x2 speakers, etc), depending on the Y position on the table. "table1" is the name of the table
- Dim tmp
- tmp = tableobj.y * 2 / table1.height-1
- If tmp > 0 Then
- AudioFade = Csng(tmp ^10)
- Else
- AudioFade = Csng(-((- tmp) ^10) )
- End If
- End Function
- Function AudioPan(tableobj) ' Calculates the pan for a tableobj based on the X position on the table. "table1" is the name of the table
- Dim tmp
- tmp = tableobj.x * 2 / table1.width-1
- If tmp > 0 Then
- AudioPan = Csng(tmp ^10)
- Else
- AudioPan = Csng(-((- tmp) ^10) )
- End If
- End Function
- Function Vol(ball) ' Calculates the Volume of the sound based on the ball speed
- Vol = Csng(BallVel(ball) ^2 / 2000)
- End Function
- Function Pitch(ball) ' Calculates the pitch of the sound based on the ball speed
- Pitch = BallVel(ball) * 20
- End Function
- Function BallVel(ball) 'Calculates the ball speed
- BallVel = INT(SQR((ball.VelX ^2) + (ball.VelY ^2) ) )
- End Function
- '*****************************************
- ' JP's VP10 Rolling Sounds
- '*****************************************
- Const tnob = 5 ' total number of balls
- ReDim rolling(tnob)
- InitRolling
- Sub InitRolling
- Dim i
- For i = 0 to tnob
- rolling(i) = False
- Next
- End Sub
- Sub RollingTimer_Timer()
- Dim BOT, b
- BOT = GetBalls
- ' stop the sound of deleted balls
- For b = UBound(BOT) + 1 to tnob
- rolling(b) = False
- StopSound("fx_ballrolling" & b)
- Next
- ' exit the sub if no balls on the table
- If UBound(BOT) = -1 Then Exit Sub
- ' play the rolling sound for each ball
- For b = 0 to UBound(BOT)
- If BallVel(BOT(b) ) > 1 AND BOT(b).z < 30 Then
- rolling(b) = True
- PlaySound("fx_ballrolling" & b), -1, Vol(BOT(b)), AudioPan(BOT(b)), 0, Pitch(BOT(b)), 1, 0, AudioFade(BOT(b))
- Else
- If rolling(b) = True Then
- StopSound("fx_ballrolling" & b)
- rolling(b) = False
- End If
- End If
- Next
- End Sub
- '**********************
- ' Ball Collision Sound
- '**********************
- Sub OnBallBallCollision(ball1, ball2, velocity)
- PlaySound("fx_collide"), 0, Csng(velocity) ^2 / 2000, AudioPan(ball1), 0, Pitch(ball1), 0, 0, AudioFade(ball1)
- End Sub
- '*****************************************
- ' ninuzzu's FLIPPER SHADOWS
- '*****************************************
- sub FlipperTimer_Timer()
- FlipperLSh.RotZ = LeftFlipper.currentangle
- FlipperRSh.RotZ = RightFlipper.currentangle
- LeftFlipperP.objRotZ = LeftFlipper.CurrentAngle-90
- RightFlipperP.objRotZ = RightFlipper.CurrentAngle-90
- End Sub
- '*****************************************
- ' ninuzzu's BALL SHADOW
- '*****************************************
- Dim BallShadow
- BallShadow = Array (BallShadow1,BallShadow2,BallShadow3,BallShadow4,BallShadow5)
- Sub BallShadowUpdate_timer()
- Dim BOT, b
- BOT = GetBalls
- ' hide shadow of deleted balls
- If UBound(BOT)<(tnob-1) Then
- For b = (UBound(BOT) + 1) to (tnob-1)
- BallShadow(b).visible = 0
- Next
- End If
- ' exit the Sub if no balls on the table
- If UBound(BOT) = -1 Then Exit Sub
- ' render the shadow for each ball
- For b = 0 to UBound(BOT)
- If BOT(b).X < Table1.Width/2 Then
- BallShadow(b).X = ((BOT(b).X) - (Ballsize/6) + ((BOT(b).X - (Table1.Width/2))/7)) + 6
- Else
- BallShadow(b).X = ((BOT(b).X) + (Ballsize/6) + ((BOT(b).X - (Table1.Width/2))/7)) - 6
- End If
- ballShadow(b).Y = BOT(b).Y + 12
- If BOT(b).Z > 20 Then
- BallShadow(b).visible = 1
- Else
- BallShadow(b).visible = 0
- End If
- Next
- End Sub
- '************************************
- ' What you need to add to your table
- '************************************
- ' a timer called RollingTimer. With a fast interval, like 10
- ' one collision sound, in this script is called fx_collide
- ' as many sound files as max number of balls, with names ending with 0, 1, 2, 3, etc
- ' for ex. as used in this script: fx_ballrolling0, fx_ballrolling1, fx_ballrolling2, fx_ballrolling3, etc
- '******************************************
- ' Explanation of the rolling sound routine
- '******************************************
- ' sounds are played based on the ball speed and position
- ' the routine checks first for deleted balls and stops the rolling sound.
- ' The For loop goes through all the balls on the table and checks for the ball speed and
- ' if the ball is on the table (height lower than 30) then then it plays the sound
- ' otherwise the sound is stopped, like when the ball has stopped or is on a ramp or flying.
- ' The sound is played using the VOL, AUDIOPAN, AUDIOFADE and PITCH functions, so the volume and pitch of the sound
- ' will change according to the ball speed, and the AUDIOPAN & AUDIOFADE functions will change the stereo position
- ' according to the position of the ball on the table.
- '**************************************
- ' Explanation of the collision routine
- '**************************************
- ' The collision is built in VP.
- ' You only need to add a Sub OnBallBallCollision(ball1, ball2, velocity) and when two balls collide they
- ' will call this routine. What you add in the sub is up to you. As an example is a simple Playsound with volume and paning
- ' depending of the speed of the collision.
- Sub Pins_Hit (idx)
- PlaySound "pinhit_low", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall)
- End Sub
- Sub Targets_Hit (idx)
- PlaySound "target", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall)
- End Sub
- Sub Metals_Thin_Hit (idx)
- PlaySound "metalhit_thin", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
- End Sub
- Sub Metals_Medium_Hit (idx)
- PlaySound "metalhit_medium", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
- End Sub
- Sub Metals2_Hit (idx)
- PlaySound "metalhit2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
- End Sub
- Sub Gates_Hit (idx)
- PlaySound "gate4", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
- End Sub
- Sub Spinner_Spin
- PlaySound "fx_spinner", 0, .25, AudioPan(Spinner), 0.25, 0, 0, 1, AudioFade(Spinner)
- End Sub
- Sub Rubbers_Hit(idx)
- dim finalspeed
- finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
- If finalspeed > 20 then
- PlaySound "fx_rubber2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
- End if
- If finalspeed >= 6 AND finalspeed <= 20 then
- RandomSoundRubber()
- End If
- End Sub
- Sub Posts_Hit(idx)
- dim finalspeed
- finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
- If finalspeed > 16 then
- PlaySound "fx_rubber2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
- End if
- If finalspeed >= 6 AND finalspeed <= 16 then
- RandomSoundRubber()
- End If
- End Sub
- Sub RandomSoundRubber()
- Select Case Int(Rnd*3)+1
- Case 1 : PlaySound "rubber_hit_1", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
- Case 2 : PlaySound "rubber_hit_2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
- Case 3 : PlaySound "rubber_hit_3", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
- End Select
- End Sub
- Sub LeftFlipper_Collide(parm)
- RandomSoundFlipper()
- End Sub
- Sub RightFlipper_Collide(parm)
- RandomSoundFlipper()
- End Sub
- Sub RandomSoundFlipper()
- Select Case Int(Rnd*3)+1
- Case 1 : PlaySound "flip_hit_1", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
- Case 2 : PlaySound "flip_hit_2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
- Case 3 : PlaySound "flip_hit_3", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
- End Select
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement