Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ' Black Pyramid - Bally 1984
- ' IPD No. 312 / July, 1984 / 4 Players
- ' VPX - version by JPSalas 2017, version 1.0.0
- 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
- LoadVPM "01550000", "Bally.vbs", 3.26
- 'Variables
- Dim bsTrough, bsSaucer, dtBank, x
- Const cGameName = "blakpyra"
- Const UseSolenoids = 1
- Const UseLamps = 0
- Const UseGI = 0
- Const UseSync = 0 'set it to 1 if the table runs too fast
- Const HandleMech = 0
- Dim VarHidden
- If Table1.ShowDT = true then
- VarHidden = 1
- For each x in aReels
- x.Visible = 1
- Next
- else
- VarHidden = 0
- For each x in aReels
- x.Visible = 0
- Next
- lrail.Visible = 0
- rrail.Visible = 0
- end if
- if B2SOn = true then VarHidden = 1
- ' Standard Sounds
- Const SSolenoidOn = "fx_Solenoid"
- Const SSolenoidOff = ""
- Const SCoin = "fx_Coin"
- 'Table Init
- Sub table1_Init
- vpmInit me
- With Controller
- .GameName = cGameName
- .SplashInfoLine = "Black Pyramid, Bally 1984" & vbNewLine & "VPX table by jpsalas"
- .HandleKeyboard = 0
- .ShowTitle = 0
- .ShowDMDOnly = 1
- .ShowFrame = 0
- .HandleMechanics = 0
- .Hidden = VarHidden
- .Games(cGameName).Settings.Value("rol") = 0 '1= rotated display, 0= normal
- '.SetDisplayPosition 0,0, GetPlayerHWnd 'restore dmd window position
- On Error Resume Next
- 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 GetPlayerHWnd
- On Error Goto 0
- End With
- 'Nudging
- vpmNudge.TiltSwitch = 15
- vpmNudge.Sensitivity = 4
- vpmNudge.TiltObj = Array(Bumper1, Bumper2, LeftSlingshot, RightSlingShot)
- 'Trough
- Set bsTrough = New cvpmBallStack
- With bsTrough
- .InitSw 0, 8, 0, 0, 0, 0, 0, 0
- .InitKick ballrelease, 90, 4
- .InitExitSnd SoundFX("fx_ballrel", DOFContactors), SoundFX("fx_Solenoid", DOFContactors)
- .Balls = 1
- End With
- 'Saucer
- Set bsSaucer = New cvpmBallStack
- With bsSaucer
- .InitSaucer sw7, 7, 200, 10
- .InitExitSnd SoundFX("fx_kicker", DOFContactors), SoundFX("fx_Solenoid", DOFContactors)
- End With
- 'Drop targets
- set dtBank = new cvpmdroptarget
- With dtBank
- .InitDrop Array(sw30, sw31, sw32), Array(30, 31, 32)
- .initsnd SoundFX("", DOFDropTargets), SoundFX("fx_resetdrop", DOFContactors)
- End With
- 'Main Timer init
- PinMAMETimer.Interval = PinMAMEInterval
- PinMAMETimer.Enabled = 1
- 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 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
- ' Slings
- Dim LStep, RStep
- Sub LeftSlingShot_Slingshot
- PlaySoundAt SoundFX("fx_slingshot", DOFContactors),Lemk
- LeftSling4.Visible = 1
- Lemk.RotX = 26
- LStep = 0
- vpmTimer.PulseSw 1
- 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 2
- 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
- ' Scoring rubbers
- Sub sw12_Hit:PlaySoundAt "fx_Rubber",ActiveBall:vpmTimer.PulseSw 12:End Sub
- Sub sw12a_Hit:PlaySoundAt "fx_Rubber",ActiveBall:vpmTimer.PulseSw 12:End Sub
- 'Moving Target
- Sub sw5a_Hit:vpmTimer.PulseSw 5:PlaySoundAt SoundFX("fx_target", DOFDropTargets), ActiveBall:End Sub
- Sub sw5b_Hit:vpmTimer.PulseSw 5:PlaySoundAt SoundFX("fx_target", DOFDropTargets), ActiveBall:End Sub
- Sub sw5c_Hit:vpmTimer.PulseSw 5:PlaySoundAt SoundFX("fx_target", DOFDropTargets), ActiveBall:End Sub
- 'Bumpers
- Sub Bumper1_Hit:vpmTimer.PulseSw 3:PlaySoundAtBumperVol SoundFX("fx_bumper", DOFContactors), Bumper1,1:End Sub
- Sub Bumper2_Hit:vpmTimer.PulseSw 4:PlaySoundAtBumperVol SoundFX("fx_bumper", DOFContactors), Bumper2,1:End Sub
- 'Drain
- Sub Drain_Hit():bsTrough.AddBall Me:PlaySoundAt "fx_drain",Drain:End Sub
- Sub sw7_Hit():bsSaucer.AddBall 0:Playsound "fx_kicker_enter", 0, 1, 0, 0.1:End Sub
- 'Rollovers
- Sub sw17_Hit:Controller.Switch(17) = 1:PlaySoundAt "fx_sensor", ActiveBall:End Sub
- Sub sw17_UnHit:Controller.Switch(17) = 0:End Sub
- Sub sw24_Hit:Controller.Switch(24) = 1:PlaySoundAt "fx_sensor", ActiveBall:End Sub
- Sub sw24_UnHit:Controller.Switch(24) = 0:End Sub
- Sub sw22_Hit:Controller.Switch(22) = 1:PlaySoundAt "fx_sensor", ActiveBall:End Sub
- Sub sw22_UnHit:Controller.Switch(22) = 0:End Sub
- Sub sw23_Hit:Controller.Switch(23) = 1:PlaySoundAt "fx_sensor", ActiveBall:End Sub
- Sub sw23_UnHit:Controller.Switch(23) = 0:End Sub
- Sub sw29_Hit:Controller.Switch(29) = 1:PlaySoundAt "fx_sensor", ActiveBall:End Sub
- Sub sw29_UnHit:Controller.Switch(29) = 0:End Sub
- Sub sw28_Hit:Controller.Switch(28) = 1:PlaySoundAt "fx_sensor", ActiveBall:End Sub
- Sub sw28_UnHit:Controller.Switch(28) = 0:End Sub
- Sub sw13_Hit:Controller.Switch(13) = 1:PlaySoundAt "fx_sensor", ActiveBall:Light1.Duration 2, 600, 1:End Sub
- Sub sw13_UnHit:Controller.Switch(13) = 0:End Sub
- Sub sw14_Hit:Controller.Switch(14) = 1:PlaySoundAt "fx_sensor", ActiveBall:Light2.Duration 2, 600, 1:End Sub
- Sub sw14_UnHit:Controller.Switch(14) = 0:End Sub
- 'Standup Targets
- Sub sw20_Hit:vpmTimer.PulseSw 20:PlaySoundAt SoundFX("fx_target", DOFDropTargets), ActiveBall:End Sub
- Sub sw21_Hit:vpmTimer.PulseSw 21:PlaySoundAt SoundFX("fx_target", DOFDropTargets), ActiveBall:End Sub
- Sub sw18_Hit:vpmTimer.PulseSw 18:PlaySoundAt SoundFX("fx_target", DOFDropTargets), ActiveBall:End Sub
- Sub sw19_Hit:vpmTimer.PulseSw 19:PlaySoundAt SoundFX("fx_target", DOFDropTargets), ActiveBall:End Sub
- ' Droptargets
- Sub sw30_Hit:PlaySoundAt SoundFX("fx_droptarget", DOFDropTargets),sw30:End Sub
- Sub sw31_Hit:PlaySoundAt SoundFX("fx_droptarget", DOFDropTargets),sw31:End Sub
- Sub sw32_Hit:PlaySoundAt SoundFX("fx_droptarget", DOFDropTargets),sw32:End Sub
- Sub sw30_Dropped:dtbank.Hit 1:End Sub
- Sub sw31_Dropped:dtbank.Hit 2:End Sub
- Sub sw32_Dropped:dtbank.Hit 3:End Sub
- '****Solenoids
- SolCallback(15) = "vpmSolSound SoundFX(""fx_knocker"",DOFKnocker),"
- SolCallback(13) = "dtBank.SolDropUp"
- SolCallback(14) = "bsTrough.SolOut"
- SolCallback(12) = "bsSaucer.SolOut"
- SolCallback(17) = "SolGate"
- SolCallback(19) = "vpmNudge.SolGameOn"
- Sub SolGate(Enabled)
- vpmSolDiverter DiverterFlipper, False, Not Enabled
- vpmSolDiverter DiverterFlipper, False, Not Enabled
- End Sub
- Set MotorCallback = GetRef("UpdateDiverter")
- Sub UpdateDiverter
- Diverter.RotZ = DiverterFlipper.CurrentAngle
- End Sub
- '*****************
- ' Gi Effects
- '*****************
- Dim OldGiState
- OldGiState = -1 'start witht he Gi off
- Sub GiON
- For each x in aGiLights
- GiEffect
- 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, 1000, 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
- '**************
- ' Flipper Subs
- '**************
- SolCallback(sLRFlipper) = "SolRFlipper"
- SolCallback(sLLFlipper) = "SolLFlipper"
- Sub SolLFlipper(Enabled)
- If Enabled Then
- PlaySoundAt SoundFX("fx_flipperup", DOFFlippers),LeftFlipper
- LeftFlipper.RotateToEnd
- Else
- PlaySoundAt SoundFX("fx_flipperdown", DOFFlippers),LeftFlipper
- LeftFlipper.RotateToStart
- End If
- End Sub
- Sub SolRFlipper(Enabled)
- If Enabled Then
- PlaySoundAt SoundFX("fx_flipperup", DOFFlippers),RightFlipper
- RightFlipper.RotateToEnd
- Else
- PlaySoundAt SoundFX("fx_flipperdown", DOFFlippers),RightFlipper
- RightFlipper.RotateToStart
- End If
- End Sub
- Sub LeftFlipper_Collide(parm)
- PlaySound "fx_rubber_flipper", 0, parm / 10, -0.1, 0.25,0,0,1,.8
- End Sub
- Sub RightFlipper_Collide(parm)
- PlaySound "fx_rubber_flipper", 0, parm / 10, 0.1, 0.25,0,0,1,.8
- End Sub
- '***********************
- ' Swing Target animation
- '***********************
- Dim MyPi, SwingStep, SwingPos
- MyPi = Round(4 * Atn(1), 6) / 90
- SwingStep = 0
- Sub SwingTimer_Timer()
- If Controller.Lamp(13)Then
- SwingPos = SIN(SwingStep * MyPi) * 50
- SwingStep = (SwingStep + 1)MOD 360
- sw5p.Roty = SwingPos
- If SwingPos < -33 Then
- sw5a.Isdropped = 0:sw5b.IsDropped = 1
- ElseIF SwingPos < 33 Then
- sw5b.Isdropped = 0:sw5a.IsDropped = 1:sw5c.IsDropped = 1
- Else
- sw5c.Isdropped = 0:sw5b.IsDropped = 1
- 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
- If VarHidden Then
- UpdateLeds
- End If
- UpdateLamps
- GIUpdate
- RollingUpdate
- End Sub
- Sub UpdateLamps
- NFadeT 1, l1, "Ball In Play"
- NFadeLm 2, l2a
- NFadeL 2, l2
- NFadeL 3, l3
- NFadeL 4, l4
- NFadeL 5, l5
- NFadeL 6, l6
- NFadeL 7, l7
- NFadeL 8, l8
- NFadeL 9, l9
- NFadeL 10, l10
- NFadeTm 11, l11a, "Same Player Shoots Again"
- NFadeL 11, l11
- NFadeL 12, l12
- NFadeL 14, l14
- NFadeL 15, l15
- NFadeL 17, l17
- NFadeLm 18, l18
- NFadeL 18, l18a
- NFadeL 19, l19
- NFadeL 20, l20
- NFadeL 21, l21
- NFadeL 22, l22
- NFadeL 23, l23
- NFadeL 24, l24
- NFadeL 25, l25
- NFadeL 26, l26
- NFadeT 27, l27, "Match"
- NFadeL 28, l28
- NFadeT 29, l29, "High Score to Date"
- NFadeL 30, l30
- NFadeL 31, l31
- 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
- NFadeL 42, l42
- NFadeL 43, l43
- NFadeL 44, l44
- NFadeT 45, l45, "Game Over"
- NFadeL 46, l46
- NFadeL 47, l47
- 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
- NFadeT 61, l61, "TILT"
- NFadeL 62, l62
- NFadeL 63, l63
- NFadeL 65, l65
- NFadeL 66, l66
- NFadeL 81, l81
- NFadeL 82, l82
- NFadeL 83, l83
- NFadeL 97, l97
- NFadeL 98, l98
- NFadeL 99, l99
- NFadeL 113, l113
- NFadeLm 114, l114a
- NFadeL 114, l114
- NFadeL 115, l115
- 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, message)
- Select Case FadingLevel(nr)
- Case 4:object.Text = ""
- Case 5:object.Text = message
- End Select
- End Sub
- '************************************
- ' LEDs Display
- ' Based on Scapino's LEDs
- '************************************
- Dim Digits(32)
- Dim Patterns(11)
- Dim Patterns2(11)
- Patterns(0) = 0 'empty
- Patterns(1) = 63 '0
- Patterns(2) = 6 '1
- Patterns(3) = 91 '2
- Patterns(4) = 79 '3
- Patterns(5) = 102 '4
- Patterns(6) = 109 '5
- Patterns(7) = 125 '6
- Patterns(8) = 7 '7
- Patterns(9) = 127 '8
- Patterns(10) = 111 '9
- Patterns2(0) = 128 'empty
- Patterns2(1) = 191 '0
- Patterns2(2) = 134 '1
- Patterns2(3) = 219 '2
- Patterns2(4) = 207 '3
- Patterns2(5) = 230 '4
- Patterns2(6) = 237 '5
- Patterns2(7) = 253 '6
- Patterns2(8) = 135 '7
- Patterns2(9) = 255 '8
- Patterns2(10) = 239 '9
- 'Assign 7-digit output to reels
- 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) = a6
- Set Digits(7) = b0
- Set Digits(8) = b1
- Set Digits(9) = b2
- Set Digits(10) = b3
- Set Digits(11) = b4
- Set Digits(12) = b5
- Set Digits(13) = b6
- Set Digits(14) = c0
- Set Digits(15) = c1
- Set Digits(16) = c2
- Set Digits(17) = c3
- Set Digits(18) = c4
- Set Digits(19) = c5
- Set Digits(20) = c6
- Set Digits(21) = d0
- Set Digits(22) = d1
- Set Digits(23) = d2
- Set Digits(24) = d3
- Set Digits(25) = d4
- Set Digits(26) = d5
- Set Digits(27) = d6
- Set Digits(28) = e0
- Set Digits(29) = e1
- Set Digits(30) = e2
- Set Digits(31) = e3
- Sub UpdateLeds
- On Error Resume Next
- Dim ChgLED, ii, jj, chg, stat
- ChgLED = Controller.ChangedLEDs(&HFF, &HFFFF)
- If Not IsEmpty(ChgLED)Then
- For ii = 0 To UBound(ChgLED)
- chg = chgLED(ii, 1):stat = chgLED(ii, 2)
- For jj = 0 to 10
- If stat = Patterns(jj)OR stat = Patterns2(jj)then Digits(chgLED(ii, 0)).SetValue jj
- Next
- Next
- End IF
- End Sub
- '******************************
- ' Diverse Collection Hit Sounds
- '******************************
- Sub aMetals_Hit(idx):PlaySound "fx_MetalHit2", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0:End Sub
- Sub aRubber_Bands_Hit(idx):PlaySound "fx_rubber_band", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0:End Sub
- Sub aRubber_Posts_Hit(idx):PlaySound "fx_rubber_post", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0:End Sub
- Sub aRubber_Pins_Hit(idx):PlaySound "fx_rubber_pin", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0:End Sub
- Sub aPlastics_Hit(idx):PlaySound "fx_PlasticHit", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0:End Sub
- Sub aGates_Hit(idx):PlaySound "fx_Gate", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0:End Sub
- Sub aWoods_Hit(idx):PlaySound "fx_Woodhit", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0: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
- Function AudioFade(ball) 'only on VPX 10.4 and newer
- 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
- '*****************************************
- ' JP's VP10 Rolling Sounds
- '*****************************************
- Const tnob = 20 ' total number of balls
- Const lob = 0 'number of locked balls
- ReDim rolling(tnob)
- InitRolling
- Sub InitRolling
- Dim i
- For i = 0 to tnob
- rolling(i) = False
- Next
- End Sub
- Sub RollingUpdate()
- Dim BOT, b, ballpitch
- 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) = lob - 1 Then Exit Sub 'there no extra balls on this table
- ' play the rolling sound for each ball
- For b = lob to UBound(BOT)
- If BallVel(BOT(b)) > 1 Then
- If BOT(b).z < 30 Then
- ballpitch = Pitch(BOT(b))
- Else
- ballpitch = Pitch(BOT(b)) + 15000 'increase the pitch on a ramp or elevated surface
- End If
- rolling(b) = True
- PlaySound("fx_ballrolling" & b), -1, Vol(BOT(b)), Pan(BOT(b)), 0, ballpitch, 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 / 200, Pan(ball1), 0, Pitch(ball1), 0, 0, AudioFade(ball1)
- End Sub
- 'Bally Black Pyramid
- 'Added by Inkochnito
- Sub editDips
- Dim vpmDips:Set vpmDips = New cvpmDips
- With vpmDips
- .AddForm 700, 400, "Black Pyramid - DIP switches"
- .AddFrame 2, 0, 190, "Maximum credits", &H03000000, Array("10 credits", 0, "15 credits", &H01000000, "25 credits", &H02000000, "40 credits", &H03000000) 'dip 25&26
- .AddFrame 2, 76, 190, "Balls per game", &HC0000000, Array("2 balls", &HC0000000, "3 balls", 0, "4 balls", &H80000000, "5 balls", &H40000000) 'dip 31&32
- .AddFrame 2, 154, 190, "Bonus special", &H00600000, Array("on after 120K", 0, "on with 120K", &H00400000, "on with 60K", &H00600000) 'dip 22&23
- .AddChk 2, 217, 100, Array("Match feature", &H08000000) 'dip 28
- .AddChk 2, 232, 100, Array("Credits display", &H04000000) 'dip 27
- .AddChk 2, 247, 100, Array("Attract sound", &H20000000) 'dip 30
- .AddFrame 205, 0, 190, "Left lane X-ball build up", &H000000C0, Array("90000", 0, "80000", &H00000040, "70000", &H00000080, "50000", &H000000C0) 'dip 7&8
- .AddFrame 205, 76, 190, "Bonus special per game", &H00000020, Array("only 1", 0, "unlimited", &H00000020) 'dip 6
- .AddFrame 205, 122, 190, "M and I return lanes", &H00002000, Array("lanes separated", 0, "lanes tied together", &H00002000) 'dip 14
- .AddFrame 205, 168, 190, "Left roll up lane", &H00100000, Array("20000 initially unlit", 0, "20000 initially lit", &H00100000) 'dip 21
- .AddFrame 205, 214, 190, "Right lane 50000", &H00800000, Array("alternates", 0, "stays on", &H00800000) 'dip 24
- .AddLabel 25, 270, 350, 20, "Set selftest position 16,17,18 and 19 to 03 for the best gameplay."
- .AddLabel 25, 290, 350, 20, "After hitting OK, press F3 to reset game with new settings."
- .ViewDips
- End With
- End Sub
- Set vpmShowDips = GetRef("editDips")
- '**************************************************************************
- ' Positional Sound Playback Functions by DJRobX
- '**************************************************************************
- 'Set position as table object (Use object or light but NOT wall) and Vol to 1
- Sub PlaySoundAt(sound, tableobj)
- PlaySound sound, 1, 1, Pan(tableobj), 0,0,0, 1, AudioFade(tableobj)
- End Sub
- 'Set all as per ball position & speed.
- Sub PlaySoundAtBall(sound)
- PlaySound sound, 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 0, 1, AudioFade(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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement