Confronta il testo

Trova la differenza tra due file di testo

Editor live

Comprimi invariate

Senza a capo

Layout

Livello di dettaglio

Evidenziazione sintassi

Diffchecker Desktop Il modo più sicuro per usare Diffchecker. Ottieni l'app Diffchecker Desktop: i tuoi diff non lasciano mai il tuo computer!Ottieni Desktop

Untitled diff

Creato 9 anni faIl diff non scade mai

31 rimozioni

Linee
Totale
Rimosso

Caratteri
Totale
Rimosso

Per continuare a utilizzare questa funzione, aggiorna a Diffchecker Pro Visualizza prezzi

767 linee

20 aggiunte

Linee
Totale
Aggiunto

Caratteri
Totale
Aggiunto

Per continuare a utilizzare questa funzione, aggiorna a Diffchecker Pro Visualizza prezzi

753 linee

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="hs_l4",UseSolenoids=1,UseLamps=0,UseGI=0,SSolenoidOn="SolOn",SSolenoidOff="SolOff", SCoin="coin"

LoadVPM "01500000", "S11.VBS", 3.10

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(1) = "bsTrough.SolIn"

SolCallback(2) = "bstrough.SolOut"

SolCallback(3) = "bsSaucer.SolOut"

SolCallback(5) = "SetLamp 105," 'PF Light

SolCallback(6) = "SetLamp 106," 'PF Light

SolCallback(7) = "bsLeftLock.SolOut" ' Left Hideout Eject

SolCallback(8) = "bsRightLock.SolOut" ' Right Hideout Eject

SolCallBack(9) = "SetLamp 109," 'X2 Left Dome Flasher

SolCallback(11) = "PFGI" 'General Illumination Relay

SolCallBack(12) = "SetLamp 112," 'X2 Right Dome Flasher

SolCallback(13) = "Divert"

SolCallback(14) = "SolKickback"

SolCallback(15)= "vpmSolSound SoundFX(""Knocker"",DOFKnocker),"

SolCallback(sLRFlipper) = "SolRFlipper"

'SolCallback(sLRFlipper) = "SolRFlipper"

SolCallback(sLLFlipper) = "SolLFlipper"

'SolCallback(sLLFlipper) = "SolLFlipper"

SolCallback(23) = "FastFlips.TiltSol"

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:RightFlipper1.RotateToEnd

Else

PlaySound SoundFX("fx_Flipperdown",DOFContactors):RightFlipper.RotateToStart:RightFlipper1.RotateToStart

End If

End Sub

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

'Solenoid Controlled toys

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

Sub SolKickBack(enabled)

If enabled Then

Plunger1.Fire

PlaySound SoundFX("Popper",DOFContactors)

Else

Plunger1.PullBack

End If

End Sub

Sub Divert(enabled)

If Enabled Then

Diverter1.IsDropped = 0

Diverter2.IsDropped = 0

PrimFlipper1.transz = -90

PrimFlipper2.transz = -90

PlaySound SoundFX("popper_ball",DOFContactors)

Else

Diverter1.IsDropped = 1

Diverter2.IsDropped = 1

PrimFlipper1.transz = 0

PrimFlipper2.transz = 0

PlaySound SoundFX("popper_ball",DOFContactors)

End If

End Sub

'Playfield GI

Sub PFGI(Enabled)

If Enabled Then

dim xx

For each xx in GI:xx.State = 0: Next

PlaySound "fx_relay"

Else

For each xx in GI:xx.State = 1: Next

PlaySound "fx_relay"

End If

End Sub

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

'Initiate Table

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

Dim bsTrough, bsSaucer, bsLeftLock, bsRightLock, SubSpeed

Dim FastFlips

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 = "High Speed (Williams)"&chr(13)&"You Suck"

.HandleMechanics=0

.HandleKeyboard=0

.ShowDMDOnly=1

.ShowFrame=0

.ShowTitle=0

.hidden = 1

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

Set FastFlips = new cFastFlips

with FastFlips

.CallBackL = "SolLflipper" 'Point these to flipper subs

.CallBackR = "SolRflipper" '...

' .CallBackUL = "SolULflipper"'...(upper flippers, if needed)

' .CallBackUR = "SolURflipper"'...

.TiltObjects = True 'Calls vpmnudge.solgameon automatically

' .InitDelay "FastFlips", 100

' .DebugOn = False 'Call FastFlips.DebugOn True or False in debugger to enable/disable.

end with

vpmNudge.TiltSwitch=1

vpmNudge.Sensitivity=3

vpmNudge.TiltObj=Array(Bumper1,Bumper2,Bumper3,LeftSlingshot,RightSlingshot)

Set bsTrough=New cvpmBallStack

bsTrough.InitSw 9,12,11,10,0,0,0,0

bsTrough.InitKick BallRelease,90,10

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

bsTrough.Balls=3

Set bsSaucer = New cvpmBallStack

bsSaucer.InitSaucer sw16,16,96,5

bsSaucer.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)

Set bsLeftLock = New cvpmBallStack

bsLeftLock.InitSw 0,0,39,0,0,0,0,0

bsLeftLock.InitSaucer LKick,40, 0,15

bsLeftLock.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)

Set bsRightLock = New cvpmBallStack

bsRightLock.InitSw 0,0,47,0,0,0,0,0

bsRightLock.InitSaucer RKick,48,0,15

bsRightLock.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)

Plunger1.Pullback

Diverter1.IsDropped = 1

Diverter2.IsDropped = 1

End Sub

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

'Plunger code

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

Sub Table1_KeyDown(ByVal KeyCode)

If KeyDownHandler(keycode) Then Exit Sub

If keycode = PlungerKey Then Plunger.Pullback:playsound"plungerpull"

If KeyCode = LeftFlipperKey then FastFlips.FlipL True' : FastFlips.FlipUL True

If KeyCode = RightFlipperKey then FastFlips.FlipR True' : FastFlips.FlipUR True

End Sub

Sub Table1_KeyUp(ByVal KeyCode)

If KeyUpHandler(keycode) Then Exit Sub

If keycode = PlungerKey Then Plunger.Fire:PlaySound"plunger"

If KeyCode = LeftFlipperKey then FastFlips.FlipL False' : FastFlips.FlipUL False

If KeyCode = RightFlipperKey then FastFlips.FlipR False' : FastFlips.FlipUR False

End Sub

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

' Drain hole and kickers

Sub Drain_Hit:bsTrough.addball me : playsound"drain" : End Sub

Sub sw16_Hit:bsSaucer.addball 0 : playsound"popper_ball" : End Sub

Sub LKick_Hit:bsLeftLock.AddBall 0 : playsound"Target" : End Sub

Sub RKick_Hit:bsRightLock.AddBall 0 : playsound"Target" : End Sub

'fake 180 turn wire Ramp

Sub kicker1_Hit

SubSpeed=ABS(ActiveBall.VelY)

kicker1.DestroyBall

kicker2.CreateBall

kicker2.Kick 180,SQR(SubSpeed)

End Sub

Sub kicker3_Hit

SubSpeed=ABS(ActiveBall.VelY)

kicker3.DestroyBall

kicker4.CreateBall

kicker4.Kick 180,SQR(SubSpeed)

End Sub

'Wire Triggers

Sub SW20_Hit : Controller.Switch(20)=1 : playsound"rollover" : End Sub

Sub SW20_unHit : Controller.Switch(20)=0:End Sub

Sub SW21_Hit : Controller.Switch(21)=1 : playsound"rollover" : End Sub

Sub SW21_unHit : Controller.Switch(21)=0:End Sub

Sub SW31_Hit : Controller.Switch(31)=1 : playsound"rollover" : End Sub

Sub SW31_unHit : Controller.Switch(31)=0 : End Sub

Sub SW32_Hit : Controller.Switch(32)=1 : playsound"rollover" : End Sub

Sub SW32_unHit : Controller.Switch(32)=0:End Sub

Sub SW36_Hit : Controller.Switch(36)=1 : playsound"rollover" : End Sub

Sub SW36_unHit : Controller.Switch(36)=0:End Sub

'Stand Up Targets

Sub sw13_Hit:vpmTimer.PulseSw 13 : End Sub

Sub sw14_Hit:vpmTimer.PulseSw 14 : End Sub

Sub sw15_Hit:vpmTimer.PulseSw 15 : End Sub

Sub sw17_Hit:vpmTimer.PulseSw 17 : End Sub

Sub sw18_Hit:vpmTimer.PulseSw 18 : End Sub

Sub sw19_Hit:vpmTimer.PulseSw 19 : End Sub

Sub sw22_Hit:vpmTimer.PulseSw 22 : End Sub

Sub sw23_Hit:vpmTimer.PulseSw 23 : End Sub

Sub sw24_Hit:vpmTimer.PulseSw 24 : End Sub

Sub sw25_Hit:vpmTimer.PulseSw 25 : End Sub

Sub sw26_Hit:vpmTimer.PulseSw 26 : End Sub

Sub sw27_Hit:vpmTimer.PulseSw 27 : End Sub

Sub sw28_Hit:vpmTimer.PulseSw 28 : End Sub

Sub sw29_Hit:vpmTimer.PulseSw 29 : End Sub

Sub sw30_Hit:vpmTimer.PulseSw 30 : End Sub

'Bumpers

Sub Bumper1_Hit:vpmTimer.PulseSw 33 : playsound SoundFX("fx_bumper1",DOFContactors): End Sub

Sub Bumper2_Hit:vpmTimer.PulseSw 34 : playsound SoundFX("fx_bumper1",DOFContactors): End Sub

Sub Bumper3_Hit:vpmTimer.PulseSw 35 : playsound SoundFX("fx_bumper1",DOFContactors): End Sub

'Ramp Triggers

Sub SW42_Hit:Controller.Switch(42)=1:End Sub

Sub SW42_unHit:Controller.Switch(42)=0:End Sub

Sub SW43_Hit:Controller.Switch(43)=1:End Sub

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

'Spinner

Sub sw44_Spin:vpmTimer.PulseSw 44 : playsound"fx_spinner" : End Sub

Sub sw45_Spin:vpmTimer.PulseSw 45 : playsound"fx_spinner" : End Sub

Sub sw46_Spin:vpmTimer.PulseSw 46 : playsound"fx_spinner" : End Sub

'Star Triggers

Sub SW51_Hit:Controller.Switch(51)=1 : playsound"rollover" : End Sub

Sub SW51_unHit:Controller.Switch(51)=0:End Sub

Sub SW52_Hit:Controller.Switch(52)=1 : playsound"rollover" : End Sub

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

'Generic Ramp Sounds

Sub Trigger1_Hit : playsound"Wire Ramp" : End Sub

Sub Trigger2_Hit : playsound"Wire Ramp" : End Sub

Sub Trigger3_Hit : playsound"Wire Ramp" : End Sub

Sub Trigger4_Hit : playsound"Wire Ramp" : End Sub

Sub Trigger5_Hit : playsound"Ball Drop" : End Sub

Sub Trigger6_Hit : playsound"Ball Drop" : End Sub

Sub Trigger7_Hit : playsound"Ball Drop" : End Sub

Sub Trigger8_Hit : playsound"Ball Drop" : End Sub

Sub Trigger9_Hit : playsound"Ball Drop" : 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

End If

UpdateLamps

End Sub

Sub UpdateLamps

'check to make sure that the kickback is disabled and didn't get re-enabled after a kick - from PacDude!

If DesktopMode = True Then

FadeReel 1 ,L1 'GameOver

FadeReel 2, L2 'Match Game

end if

NFadeLm 3, l3

If DesktopMode = True Then

FadeReel 3, L3a 'Shoot Again

end if

NFadeL 4, l4

NFadeL 5, l5

If DesktopMode = True Then

FadeReel 6, L6 'Ball In Play

end if

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 28, l28

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 39, l39

NFadeL 40, l40

NFadeL 41, l41

NFadeObjm 42, l42, "bulbcover1_redOn", "bulbcover1_red"

Flash 42, F42 'Ramp Traffic Light

NFadeObjm 43, l43, "bulbcover1_yellowOn", "bulbcover1_yellow"

Flash 43, F43 'Ramp Traffic Light

NFadeObjm 44, l44, "bulbcover1_greenOn", "bulbcover1_green"

Flash 44, F44 'Ramp Traffic Light

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 59, l59

NFadeL 60, l60

NFadeL 61, l61

NFadeL 62, l62

NFadeL 63, l63

NFadeL 64, l64

'Solenoid Controlled Flashers

NFadeL 105, F105

NFadeL 106, F106

NFadeLm 109, F109

NFadeLm 109, F109a

NFadeLm 109, F109b

NFadeL 109, F109c

NFadeLm 112, F112

NFadeLm 112, F112a

NFadeLm 112, F112b

NFadeL 112, F112c

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

End Sub

Sub AllLampsOff

Dim x

For x = 0 to 200

SetLamp x, 0

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

'Reels

Sub FadeReel(nr, reel)

Select Case FadingLevel(nr)

Case 2:FadingLevel(nr) = 0

Case 3:FadingLevel(nr) = 2

Case 4:reel.Visible = 0:FadingLevel(nr) = 3

Case 5:reel.Visible = 1:FadingLevel(nr) = 1

End Select

End Sub

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

'Digital Display

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

Dim Digits(28)

Digits(0)=Array(a00, a05, a0c, a0d, a08, a01, a06, a0f, a02, a03, a04, a07, a0b, a0a, a09, a0e)

Digits(1)=Array(a10, a15, a1c, a1d, a18, a11, a16, a1f, a12, a13, a14, a17, a1b, a1a, a19, a1e)

Digits(2)=Array(a20, a25, a2c, a2d, a28, a21, a26, a2f, a22, a23, a24, a27, a2b, a2a, a29, a2e)

Digits(3)=Array(a30, a35, a3c, a3d, a38, a31, a36, a3f, a32, a33, a34, a37, a3b, a3a, a39, a3e)

Digits(4)=Array(a40, a45, a4c, a4d, a48, a41, a46, a4f, a42, a43, a44, a47, a4b, a4a, a49, a4e)

Digits(5)=Array(a50, a55, a5c, a5d, a58, a51, a56, a5f, a52, a53, a54, a57, a5b, a5a, a59, a5e)

Digits(6)=Array(a60, a65, a6c, a6d, a68, a61, a66, a6f, a62, a63, a64, a67, a6b, a6a, a69, a6e)

Digits(7)=Array(a70, a75, a7c, a7d, a78, a71, a76, a7f, a72, a73, a74, a77, a7b, a7a, a79, a7e)

Digits(8)=Array(a80, a85, a8c, a8d, a88, a81, a86, a8f, a82, a83, a84, a87, a8b, a8a, a89, a8e)

Digits(9)=Array(a90, a95, a9c, a9d, a98, a91, a96, a9f, a92, a93, a94, a97, a9b, a9a, a99, a9e)

Digits(10)=Array(aa0, aa5, aac, aad, aa8, aa1, aa6, aaf, aa2, aa3, aa4, aa7, aab, aaa, aa9, aae)

Digits(11)=Array(ab0, ab5, abc, abd, ab8, ab1, ab6, abf, ab2, ab3, ab4, ab7, abb, aba, ab9, abe)

Digits(12)=Array(ac0, ac5, acc, acd, ac8, ac1, ac6, acf, ac2, ac3, ac4, ac7, acb, aca, ac9, ace)

Digits(13)=Array(ad0, ad5, adc, add, ad8, ad1, ad6, adf, ad2, ad3, ad4, ad7, adb, ada, ad9, ade)

' 3rd Player

Digits(14) = Array(LED150,LED151,LED152,LED153,LED154,LED155,LED156)

Digits(15) = Array(LED160,LED161,LED162,LED163,LED164,LED165,LED166)

Digits(16) = Array(LED170,LED171,LED172,LED173,LED174,LED175,LED176)

Digits(17) = Array(LED180,LED181,LED182,LED183,LED184,LED185,LED186)

Digits(18) = Array(LED190,LED191,LED192,LED193,LED194,LED195,LED196)

Digits(19) = Array(LED200,LED201,LED202,LED203,LED204,LED205,LED206)

Digits(20) = Array(LED210,LED211,LED212,LED213,LED214,LED215,LED216)

' 4th Player

Digits(21) = Array(LED220,LED221,LED222,LED223,LED224,LED225,LED226)

Digits(22) = Array(LED230,LED231,LED232,LED233,LED234,LED235,LED236)

Digits(23) = Array(LED240,LED241,LED242,LED243,LED244,LED245,LED246)

Digits(24) = Array(LED250,LED251,LED252,LED253,LED254,LED255,LED256)

Digits(25) = Array(LED260,LED261,LED262,LED263,LED264,LED265,LED266)

Digits(26) = Array(LED270,LED271,LED272,LED273,LED274,LED275,LED276)

Digits(27) = Array(LED280,LED281,LED282,LED283,LED284,LED285,LED286)

Sub DisplayTimer_Timer

Dim ChgLED, ii, jj, num, chg, stat, obj, b, x

ChgLED=Controller.ChangedLEDs(&Hffffffff, &Hffffffff)

If Not IsEmpty(ChgLED)Then

If DesktopMode = True Then

For ii=0 To UBound(chgLED)

num=chgLED(ii, 0) : chg=chgLED(ii, 1) : stat=chgLED(ii, 2)

if (num < 28) then

For Each obj In Digits(num)

If chg And 1 Then obj.State=stat And 1

chg=chg\2 : stat=stat\2

Else

end if

End If

End Sub

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

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

'Start of VPX call back Functions

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

'**********Sling Shot Animations

' Rstep and Lstep are the variables that increment the animation

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

Dim RStep, Lstep

Sub RightSlingShot_Slingshot

vpmTimer.PulseSw 50

PlaySound SoundFX("right_slingshot",DOFContactors), 0, 1, 0.05, 0.05

RSling.Visible = 0

RSling1.Visible = 1

sling1.TransZ = -20

RStep = 0

RightSlingShot.TimerEnabled = 1

End Sub

Sub RightSlingShot_Timer

Select Case RStep

Case 3:RSLing1.Visible = 0:RSLing2.Visible = 1:sling1.TransZ = -10

Case 4:RSLing2.Visible = 0:RSLing.Visible = 1:sling1.TransZ = 0:RightSlingShot.TimerEnabled = 0:

End Select

RStep = RStep + 1

End Sub

Sub LeftSlingShot_Slingshot

vpmTimer.PulseSw 49

PlaySound SoundFX("left_slingshot",DOFContactors),0,1,-0.05,0.05

LSling.Visible = 0

LSling1.Visible = 1

sling2.TransZ = -20

LStep = 0

LeftSlingShot.TimerEnabled = 1

End Sub

Sub LeftSlingShot_Timer

Select Case LStep

Case 3:LSLing1.Visible = 0:LSLing2.Visible = 1:sling2.TransZ = -10

Case 4:LSLing2.Visible = 0:LSLing.Visible = 1:sling2.TransZ = 0:LeftSlingShot.TimerEnabled = 0:

End Select

LStep = LStep + 1

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

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

' 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

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)

' 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) ), 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 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

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

' 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, PAN and PITCH functions, so the volume and pitch of the sound

' will change according to the ball speed, and the PAN function 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), Pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0

PlaySound "pinhit_low", 0, Vol(ActiveBall), P

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 Spinner_Spin

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

End Sub

Sub Rubbers_Hit(idx)

dim finalspeed

finalspeed=SQR(activeball.velx * activeball.velx + ac

Diff salvati

Testo originale

Apri file

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="hs_l4",UseSolenoids=1,UseLamps=0,UseGI=0,SSolenoidOn="SolOn",SSolenoidOff="SolOff", SCoin="coin"

LoadVPM "01500000", "S11.VBS", 3.10
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(1)		= "bsTrough.SolIn"
SolCallback(2)		= "bstrough.SolOut"
SolCallback(3)		= "bsSaucer.SolOut"
SolCallback(5)		= "SetLamp 105," 'PF Light
SolCallback(6)		= "SetLamp 106," 'PF Light
SolCallback(7)		= "bsLeftLock.SolOut"           ' Left Hideout Eject
SolCallback(8)		= "bsRightLock.SolOut"          ' Right Hideout Eject
SolCallBack(9)      = "SetLamp 109," 'X2 Left Dome Flasher
SolCallback(11)		= "PFGI" 'General Illumination Relay
SolCallBack(12)     = "SetLamp 112," 'X2 Right Dome Flasher
SolCallback(13)	    = "Divert"
SolCallback(14)     = "SolKickback"
SolCallback(15)=  "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:RightFlipper1.RotateToEnd
     Else
         PlaySound SoundFX("fx_Flipperdown",DOFContactors):RightFlipper.RotateToStart:RightFlipper1.RotateToStart
     End If
End Sub

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

'Solenoid Controlled toys
'**********************************************************************************************************

Sub SolKickBack(enabled)
    If enabled Then
       Plunger1.Fire
       PlaySound SoundFX("Popper",DOFContactors)
    Else
       Plunger1.PullBack
    End If
End Sub

Sub Divert(enabled)
	If Enabled Then 
		Diverter1.IsDropped = 0  
		Diverter2.IsDropped = 0 
		PrimFlipper1.transz = -90
		PrimFlipper2.transz = -90
        PlaySound SoundFX("popper_ball",DOFContactors)
	Else
		Diverter1.IsDropped = 1
		Diverter2.IsDropped = 1
		PrimFlipper1.transz = 0
		PrimFlipper2.transz = 0
        PlaySound SoundFX("popper_ball",DOFContactors)
	End If
End Sub

'Playfield GI
Sub PFGI(Enabled)
	If Enabled Then
		dim xx
		For each xx in GI:xx.State = 0: Next
        PlaySound "fx_relay"
	Else
		For each xx in GI:xx.State = 1: Next
        PlaySound "fx_relay"
	End If
End Sub

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

'Initiate Table
'**********************************************************************************************************

Dim bsTrough, bsSaucer, bsLeftLock, bsRightLock, SubSpeed

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 = "High Speed (Williams)"&chr(13)&"You Suck"
		.HandleMechanics=0
		.HandleKeyboard=0
		.ShowDMDOnly=1
		.ShowFrame=0
		.ShowTitle=0
        .hidden = 1
         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=1
	vpmNudge.Sensitivity=3
	vpmNudge.TiltObj=Array(Bumper1,Bumper2,Bumper3,LeftSlingshot,RightSlingshot)
	
	Set bsTrough=New cvpmBallStack
		bsTrough.InitSw 9,12,11,10,0,0,0,0
		bsTrough.InitKick BallRelease,90,10 
		bsTrough.InitExitSnd SoundFX("ballrelease",DOFContactors), SoundFX("Solenoid",DOFContactors)
		bsTrough.Balls=3
 
	Set bsSaucer = New cvpmBallStack
		bsSaucer.InitSaucer sw16,16,96,5
		bsSaucer.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)

Set bsLeftLock = New cvpmBallStack
		bsLeftLock.InitSw 0,0,39,0,0,0,0,0
		bsLeftLock.InitSaucer LKick,40, 0,15
		bsLeftLock.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)

Set bsRightLock = New cvpmBallStack
		bsRightLock.InitSw 0,0,47,0,0,0,0,0
		bsRightLock.InitSaucer RKick,48,0,15
		bsRightLock.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)

Plunger1.Pullback
	Diverter1.IsDropped = 1
	Diverter2.IsDropped = 1

End Sub
 
'**********************************************************************************************************
'Plunger code
'**********************************************************************************************************

Sub Table1_KeyDown(ByVal KeyCode)
	If KeyDownHandler(keycode) Then Exit Sub
	If keycode = PlungerKey Then Plunger.Pullback:playsound"plungerpull"
End Sub

Sub Table1_KeyUp(ByVal KeyCode)
	If KeyUpHandler(keycode) Then Exit Sub
	If keycode = PlungerKey Then Plunger.Fire:PlaySound"plunger"
End Sub

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

' Drain hole and kickers
Sub Drain_Hit:bsTrough.addball me : playsound"drain" : End Sub
Sub sw16_Hit:bsSaucer.addball 0 : playsound"popper_ball" : End Sub
Sub LKick_Hit:bsLeftLock.AddBall 0 : playsound"Target" : End Sub
Sub RKick_Hit:bsRightLock.AddBall 0 : playsound"Target" : End Sub

'fake 180 turn wire Ramp
Sub kicker1_Hit
 	SubSpeed=ABS(ActiveBall.VelY)
 	kicker1.DestroyBall
 	kicker2.CreateBall
 	kicker2.Kick 180,SQR(SubSpeed)
End Sub

Sub kicker3_Hit
 	SubSpeed=ABS(ActiveBall.VelY)
 	kicker3.DestroyBall
 	kicker4.CreateBall
 	kicker4.Kick 180,SQR(SubSpeed)
End Sub

'Wire Triggers
Sub SW20_Hit : Controller.Switch(20)=1 : playsound"rollover" : End Sub 
Sub SW20_unHit : Controller.Switch(20)=0:End Sub
Sub SW21_Hit : Controller.Switch(21)=1 : playsound"rollover" : End Sub 
Sub SW21_unHit : Controller.Switch(21)=0:End Sub
Sub SW31_Hit : Controller.Switch(31)=1 : playsound"rollover" : End Sub 
Sub SW31_unHit : Controller.Switch(31)=0 : End Sub
Sub SW32_Hit : Controller.Switch(32)=1 : playsound"rollover" : End Sub 
Sub SW32_unHit : Controller.Switch(32)=0:End Sub
Sub SW36_Hit : Controller.Switch(36)=1 : playsound"rollover" : End Sub 
Sub SW36_unHit : Controller.Switch(36)=0:End Sub

'Stand Up Targets
Sub sw13_Hit:vpmTimer.PulseSw 13 : End Sub
Sub sw14_Hit:vpmTimer.PulseSw 14 : End Sub
Sub sw15_Hit:vpmTimer.PulseSw 15 : End Sub
Sub sw17_Hit:vpmTimer.PulseSw 17 : End Sub
Sub sw18_Hit:vpmTimer.PulseSw 18 : End Sub
Sub sw19_Hit:vpmTimer.PulseSw 19 : End Sub
Sub sw22_Hit:vpmTimer.PulseSw 22 : End Sub
Sub sw23_Hit:vpmTimer.PulseSw 23 : End Sub
Sub sw24_Hit:vpmTimer.PulseSw 24 : End Sub
Sub sw25_Hit:vpmTimer.PulseSw 25 : End Sub
Sub sw26_Hit:vpmTimer.PulseSw 26 : End Sub
Sub sw27_Hit:vpmTimer.PulseSw 27 : End Sub
Sub sw28_Hit:vpmTimer.PulseSw 28 : End Sub
Sub sw29_Hit:vpmTimer.PulseSw 29 : End Sub
Sub sw30_Hit:vpmTimer.PulseSw 30 : End Sub

'Bumpers
Sub Bumper1_Hit:vpmTimer.PulseSw 33 : playsound SoundFX("fx_bumper1",DOFContactors): End Sub
Sub Bumper2_Hit:vpmTimer.PulseSw 34 : playsound SoundFX("fx_bumper1",DOFContactors): End Sub
Sub Bumper3_Hit:vpmTimer.PulseSw 35 : playsound SoundFX("fx_bumper1",DOFContactors): End Sub

'Ramp Triggers
Sub SW42_Hit:Controller.Switch(42)=1:End Sub
Sub SW42_unHit:Controller.Switch(42)=0:End Sub
Sub SW43_Hit:Controller.Switch(43)=1:End Sub
Sub SW43_unHit:Controller.Switch(43)=0:End Sub

'Spinner
Sub sw44_Spin:vpmTimer.PulseSw 44 : playsound"fx_spinner" : End Sub
Sub sw45_Spin:vpmTimer.PulseSw 45 : playsound"fx_spinner" : End Sub
Sub sw46_Spin:vpmTimer.PulseSw 46 : playsound"fx_spinner" : End Sub

'Star Triggers
Sub SW51_Hit:Controller.Switch(51)=1 : playsound"rollover" : End Sub 
Sub SW51_unHit:Controller.Switch(51)=0:End Sub
Sub SW52_Hit:Controller.Switch(52)=1 : playsound"rollover" : End Sub 
Sub SW52_unHit:Controller.Switch(52)=0:End Sub

'Generic Ramp Sounds
Sub Trigger1_Hit : playsound"Wire Ramp" : End Sub
Sub Trigger2_Hit : playsound"Wire Ramp" : End Sub
Sub Trigger3_Hit : playsound"Wire Ramp" : End Sub
Sub Trigger4_Hit : playsound"Wire Ramp" : End Sub

Sub Trigger5_Hit : playsound"Ball Drop" : End Sub
Sub Trigger6_Hit : playsound"Ball Drop" : End Sub
Sub Trigger7_Hit : playsound"Ball Drop" : End Sub
Sub Trigger8_Hit : playsound"Ball Drop" : End Sub
Sub Trigger9_Hit : playsound"Ball Drop" : 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
        Next
    End If
    UpdateLamps
End Sub

Sub UpdateLamps
  'check to make sure that the kickback is disabled and didn't get re-enabled after a kick - from PacDude!
  	
If DesktopMode = True Then
	FadeReel 1 ,L1 'GameOver
 	FadeReel 2, L2 'Match Game
end if

NFadeLm 3, l3

If DesktopMode = True Then
 	FadeReel 3, L3a 'Shoot Again
end if

NFadeL 4, l4
   	NFadeL 5, l5

If DesktopMode = True Then
 	FadeReel 6, L6 'Ball In Play
end if

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 28, l28
   	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 39, l39
   	NFadeL 40, l40
   	NFadeL 41, l41    
	NFadeObjm 42, l42, "bulbcover1_redOn", "bulbcover1_red" 
   	Flash 42, F42 'Ramp Traffic Light
	NFadeObjm 43, l43, "bulbcover1_yellowOn", "bulbcover1_yellow"
   	Flash 43, F43 'Ramp Traffic Light
	NFadeObjm 44, l44, "bulbcover1_greenOn", "bulbcover1_green"
   	Flash 44, F44 'Ramp Traffic Light
   	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 59, l59
   	NFadeL 60, l60
   	NFadeL 61, l61
   	NFadeL 62, l62
   	NFadeL 63, l63
   	NFadeL 64, l64
 
 'Solenoid Controlled Flashers
   NFadeL 105, F105

NFadeL 106, F106

NFadeLm 109, F109
   NFadeLm 109, F109a
   NFadeLm 109, F109b
   NFadeL 109, F109c

NFadeLm 112, F112
   NFadeLm 112, F112a
   NFadeLm 112, F112b
   NFadeL 112, F112c
 
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

'Reels
Sub FadeReel(nr, reel)
    Select Case FadingLevel(nr)
        Case 2:FadingLevel(nr) = 0
        Case 3:FadingLevel(nr) = 2
        Case 4:reel.Visible = 0:FadingLevel(nr) = 3
        Case 5:reel.Visible = 1:FadingLevel(nr) = 1
    End Select
End Sub

'**********************************************************************************************************
'Digital Display
'**********************************************************************************************************
 Dim Digits(28)
 Digits(0)=Array(a00, a05, a0c, a0d, a08, a01, a06, a0f, a02, a03, a04, a07, a0b, a0a, a09, a0e)
 Digits(1)=Array(a10, a15, a1c, a1d, a18, a11, a16, a1f, a12, a13, a14, a17, a1b, a1a, a19, a1e)
 Digits(2)=Array(a20, a25, a2c, a2d, a28, a21, a26, a2f, a22, a23, a24, a27, a2b, a2a, a29, a2e)
 Digits(3)=Array(a30, a35, a3c, a3d, a38, a31, a36, a3f, a32, a33, a34, a37, a3b, a3a, a39, a3e)
 Digits(4)=Array(a40, a45, a4c, a4d, a48, a41, a46, a4f, a42, a43, a44, a47, a4b, a4a, a49, a4e)
 Digits(5)=Array(a50, a55, a5c, a5d, a58, a51, a56, a5f, a52, a53, a54, a57, a5b, a5a, a59, a5e)
 Digits(6)=Array(a60, a65, a6c, a6d, a68, a61, a66, a6f, a62, a63, a64, a67, a6b, a6a, a69, a6e)

Digits(7)=Array(a70, a75, a7c, a7d, a78, a71, a76, a7f, a72, a73, a74, a77, a7b, a7a, a79, a7e)
 Digits(8)=Array(a80, a85, a8c, a8d, a88, a81, a86, a8f, a82, a83, a84, a87, a8b, a8a, a89, a8e)
 Digits(9)=Array(a90, a95, a9c, a9d, a98, a91, a96, a9f, a92, a93, a94, a97, a9b, a9a, a99, a9e)
 Digits(10)=Array(aa0, aa5, aac, aad, aa8, aa1, aa6, aaf, aa2, aa3, aa4, aa7, aab, aaa, aa9, aae)
 Digits(11)=Array(ab0, ab5, abc, abd, ab8, ab1, ab6, abf, ab2, ab3, ab4, ab7, abb, aba, ab9, abe)
 Digits(12)=Array(ac0, ac5, acc, acd, ac8, ac1, ac6, acf, ac2, ac3, ac4, ac7, acb, aca, ac9, ace)
 Digits(13)=Array(ad0, ad5, adc, add, ad8, ad1, ad6, adf, ad2, ad3, ad4, ad7, adb, ada, ad9, ade)

' 3rd Player
Digits(14) = Array(LED150,LED151,LED152,LED153,LED154,LED155,LED156)
Digits(15) = Array(LED160,LED161,LED162,LED163,LED164,LED165,LED166)
Digits(16) = Array(LED170,LED171,LED172,LED173,LED174,LED175,LED176)
Digits(17) = Array(LED180,LED181,LED182,LED183,LED184,LED185,LED186)
Digits(18) = Array(LED190,LED191,LED192,LED193,LED194,LED195,LED196)
Digits(19) = Array(LED200,LED201,LED202,LED203,LED204,LED205,LED206)
Digits(20) = Array(LED210,LED211,LED212,LED213,LED214,LED215,LED216)

' 4th Player
Digits(21) = Array(LED220,LED221,LED222,LED223,LED224,LED225,LED226)
Digits(22) = Array(LED230,LED231,LED232,LED233,LED234,LED235,LED236)
Digits(23) = Array(LED240,LED241,LED242,LED243,LED244,LED245,LED246)
Digits(24) = Array(LED250,LED251,LED252,LED253,LED254,LED255,LED256)
Digits(25) = Array(LED260,LED261,LED262,LED263,LED264,LED265,LED266)
Digits(26) = Array(LED270,LED271,LED272,LED273,LED274,LED275,LED276)
Digits(27) = Array(LED280,LED281,LED282,LED283,LED284,LED285,LED286)

Sub DisplayTimer_Timer
    Dim ChgLED, ii, jj, num, chg, stat, obj, b, x
    ChgLED=Controller.ChangedLEDs(&Hffffffff, &Hffffffff)
    If Not IsEmpty(ChgLED)Then
		If DesktopMode = True Then
       For ii=0 To UBound(chgLED)
          num=chgLED(ii, 0) : chg=chgLED(ii, 1) : stat=chgLED(ii, 2)
			if (num < 28) then
              For Each obj In Digits(num)
                   If chg And 1 Then obj.State=stat And 1
                   chg=chg\2 : stat=stat\2
                  Next
			Else
			       end if
        Next
	   end if
    End If
 End Sub

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

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

'Start of VPX call back Functions

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

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

Sub RightSlingShot_Slingshot
	vpmTimer.PulseSw 50
    PlaySound SoundFX("right_slingshot",DOFContactors), 0, 1, 0.05, 0.05
    RSling.Visible = 0
    RSling1.Visible = 1
    sling1.TransZ = -20
    RStep = 0
    RightSlingShot.TimerEnabled = 1
End Sub

Sub RightSlingShot_Timer
    Select Case RStep
        Case 3:RSLing1.Visible = 0:RSLing2.Visible = 1:sling1.TransZ = -10
        Case 4:RSLing2.Visible = 0:RSLing.Visible = 1:sling1.TransZ = 0:RightSlingShot.TimerEnabled = 0:
    End Select
    RStep = RStep + 1
End Sub

Sub LeftSlingShot_Slingshot
	vpmTimer.PulseSw 49
    PlaySound SoundFX("left_slingshot",DOFContactors),0,1,-0.05,0.05
    LSling.Visible = 0
    LSling1.Visible = 1
    sling2.TransZ = -20
    LStep = 0
    LeftSlingShot.TimerEnabled = 1
End Sub

Sub LeftSlingShot_Timer
    Select Case LStep
        Case 3:LSLing1.Visible = 0:LSLing2.Visible = 1:sling2.TransZ = -10
        Case 4:LSLing2.Visible = 0:LSLing.Visible = 1:sling2.TransZ = 0:LeftSlingShot.TimerEnabled = 0:
    End Select
    LStep = LStep + 1
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

'*****************************************
'      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) ), 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

'************************************
' 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, PAN and PITCH functions, so the volume and pitch of the sound
' will change according to the ball speed, and the PAN function 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), 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 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

Testo modificato

Apri file

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="hs_l4",UseSolenoids=1,UseLamps=0,UseGI=0,SSolenoidOn="SolOn",SSolenoidOff="SolOff", SCoin="coin"

LoadVPM "01500000", "S11.VBS", 3.10
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

'SolCallback(sLRFlipper) = "SolRFlipper"
'SolCallback(sLLFlipper) = "SolLFlipper"
SolCallback(23) = "FastFlips.TiltSol"
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:RightFlipper1.RotateToEnd
     Else
         PlaySound SoundFX("fx_Flipperdown",DOFContactors):RightFlipper.RotateToStart:RightFlipper1.RotateToStart
     End If
End Sub

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

'Solenoid Controlled toys
'**********************************************************************************************************

Sub SolKickBack(enabled)
    If enabled Then
       Plunger1.Fire
       PlaySound SoundFX("Popper",DOFContactors)
    Else
       Plunger1.PullBack
    End If
End Sub

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

'Initiate Table
'**********************************************************************************************************

Dim bsTrough, bsSaucer, bsLeftLock, bsRightLock, SubSpeed
Dim FastFlips
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 = "High Speed (Williams)"&chr(13)&"You Suck"
		.HandleMechanics=0
		.HandleKeyboard=0
		.ShowDMDOnly=1
		.ShowFrame=0
		.ShowTitle=0
        .hidden = 1
         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

Set FastFlips = new cFastFlips
	with FastFlips
		.CallBackL = "SolLflipper"	'Point these to flipper subs
		.CallBackR = "SolRflipper"	'...
	'	.CallBackUL = "SolULflipper"'...(upper flippers, if needed)
	'	.CallBackUR = "SolURflipper"'...
		.TiltObjects = True 'Calls vpmnudge.solgameon automatically
	'	.InitDelay "FastFlips", 100
	'	.DebugOn = False		'Call FastFlips.DebugOn True or False in debugger to enable/disable.
	end with

Plunger1.Pullback
	Diverter1.IsDropped = 1
	Diverter2.IsDropped = 1

Sub Table1_KeyDown(ByVal KeyCode)
	If KeyDownHandler(keycode) Then Exit Sub
	If keycode = PlungerKey Then Plunger.Pullback:playsound"plungerpull"
	If KeyCode = LeftFlipperKey then FastFlips.FlipL True' :  FastFlips.FlipUL True
	If KeyCode = RightFlipperKey then FastFlips.FlipR True' :  FastFlips.FlipUR True
End Sub

Sub Table1_KeyUp(ByVal KeyCode)
	If KeyUpHandler(keycode) Then Exit Sub
	If keycode = PlungerKey Then Plunger.Fire:PlaySound"plunger"
	If KeyCode = LeftFlipperKey then FastFlips.FlipL False' :  FastFlips.FlipUL False
	If KeyCode = RightFlipperKey then FastFlips.FlipR False' :  FastFlips.FlipUR False
End Sub