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="jokrpokr",UseSolenoids=1,UseLamps=1,UseGI=0,SSolenoidOn="SolOn",SSolenoidOff="SolOff",SCoin="coin"
- LoadVPM"01150000","GTS1.VBS",3.10
- '*******************************************
- ' User Options
- '*******************************************
- '----- Shadow Options -----
- Const DynamicBallShadowsOn = 1 '0 = no dynamic ball shadow, 1 = enable dynamic ball shadow
- '----- General Sound Options -----
- Const VolumeDial = 0.8 ' Recommended values should be no greater than 1.
- '----- Phsyics Mods -----
- Const RubberizerEnabled = 1 '0 = normal flip rubber, 1 = more lively rubber for flips
- Const FlipperCoilRampupMode = 1 '0 = fast, 1 = medium, 2 = slow (tap passes should work)
- Const TargetBouncerEnabled = 1 '0 = normal standup targets, 1 = bouncy targets
- Const TargetBouncerFactor = 0.7 'Level of bounces. 0.0 thru 1.0, higher value is more bounciness (don't go above 1)
- Dim DesktopMode: DesktopMode = Table1.ShowDT
- If DesktopMode = True Then 'Show Desktop components
- Ramp16.visible=1
- Ramp15.visible=1
- Primitive35.visible=1
- Else
- Ramp16.visible=0
- Ramp15.visible=0
- Primitive35.visible=0
- End if
- '*************************************************************
- 'Solenoid Call backs
- '**********************************************************************************************************
- 'UpDated by Outhere
- '201 Bumper Left
- '202 Bumper Right
- '203 SlingShot Left
- SolCallback(1)="bsTrough.SolOut"
- SolCallback(2)="SolKnocker"
- SolCallback(3)="vpmSolSound ""10"","
- SolCallback(4)="vpmSolSound ""100"","
- SolCallback(5)="vpmSolSound ""1000"","
- SolCallback(6)="dtjj.SolDropUp" '10,J,J
- SolCallback(7)="dtqq.SolDropUp" 'Q,Q,Q
- SolCallback(8)="dtaa.SolDropUp" 'A,A,JOKER,A,A
- SolCallback(17)="vpmNudge.SolGameOn"
- 'L17 Is used for DropUp KKKK
- SolCallback(sLRFlipper) = "SolRFlipper"
- SolCallback(sLLFlipper) = "SolLFlipper"
- Const ReflipAngle = 20
- Sub SolLFlipper(Enabled)
- If Enabled Then
- LF.Fire 'leftflipper.rotatetoend
- LeftFlipper.RotateToEnd
- If leftflipper.currentangle < leftflipper.endangle + ReflipAngle Then
- RandomSoundReflipUpLeft LeftFlipper
- Else
- SoundFlipperUpAttackLeft LeftFlipper
- RandomSoundFlipperUpLeft LeftFlipper
- End If
- Else
- LeftFlipper.RotateToStart
- If LeftFlipper.currentangle < LeftFlipper.startAngle - 5 Then
- RandomSoundFlipperDownLeft LeftFlipper
- End If
- FlipperLeftHitParm = FlipperUpSoundLevel
- End If
- End Sub
- Sub SolRFlipper(Enabled)
- If Enabled Then
- RF.Fire 'rightflipper.rotatetoend
- RightFlipper.RotateToEnd:RightFlipper1.RotateToEnd
- If rightflipper.currentangle > rightflipper.endangle - ReflipAngle Then
- RandomSoundReflipUpRight RightFlipper
- Else
- SoundFlipperUpAttackRight RightFlipper
- RandomSoundFlipperUpRight RightFlipper
- End If
- Else
- RightFlipper.RotateToStart:RightFlipper1.RotateToStart
- If RightFlipper.currentangle > RightFlipper.startAngle + 5 Then
- RandomSoundFlipperDownRight RightFlipper
- End If
- FlipperRightHitParm = FlipperUpSoundLevel
- End If
- End Sub
- Sub LeftFlipper_Collide(parm)
- CheckLiveCatch Activeball, LeftFlipper, LFCount, parm
- LeftFlipperCollide parm
- if RubberizerEnabled = 1 then Rubberizer(parm)
- if RubberizerEnabled = 2 then Rubberizer2(parm)
- End Sub
- Sub RightFlipper_Collide(parm)
- CheckLiveCatch Activeball, RightFlipper, RFCount, parm
- RightFlipperCollide parm
- if RubberizerEnabled = 1 then Rubberizer(parm)
- if RubberizerEnabled = 2 then Rubberizer2(parm)
- End Sub
- ' iaakki Rubberizer
- sub Rubberizer(parm)
- if parm < 10 And parm > 2 And Abs(activeball.angmomz) < 10 then
- 'debug.print "parm: " & parm & " momz: " & activeball.angmomz &" vely: "& activeball.vely
- activeball.angmomz = activeball.angmomz * 1.2
- activeball.vely = activeball.vely * 1.2
- 'debug.print ">> newmomz: " & activeball.angmomz&" newvely: "& activeball.vely
- Elseif parm <= 2 and parm > 0.2 Then
- 'debug.print "* parm: " & parm & " momz: " & activeball.angmomz &" vely: "& activeball.vely
- activeball.angmomz = activeball.angmomz * -1.1
- activeball.vely = activeball.vely * 1.4
- 'debug.print "**** >> newmomz: " & activeball.angmomz&" newvely: "& activeball.vely
- end if
- end sub
- ' apophis rubberizer
- sub Rubberizer2(parm)
- if parm < 10 And parm > 2 And Abs(activeball.angmomz) < 10 then
- 'debug.print "parm: " & parm & " momz: " & activeball.angmomz &" vely: "& activeball.vely
- activeball.angmomz = -activeball.angmomz * 2
- activeball.vely = activeball.vely * 1.2
- 'debug.print ">> newmomz: " & activeball.angmomz&" newvely: "& activeball.vely
- Elseif parm <= 2 and parm > 0.2 Then
- 'debug.print "* parm: " & parm & " momz: " & activeball.angmomz &" vely: "& activeball.vely
- activeball.angmomz = -activeball.angmomz * 0.5
- activeball.vely = activeball.vely * (1.2 + rnd(1)/3 )
- 'debug.print "**** >> newmomz: " & activeball.angmomz&" newvely: "& activeball.vely
- end if
- end sub
- Sub SolKnocker(Enabled)
- If enabled Then
- KnockerSolenoid 'Add knocker position object
- End If
- End Sub
- '*****GI Lights On
- dim xx
- For each xx in GI:xx.State = 1: Next
- '**********************************************************************************************************
- 'Initiate Table
- '**********************************************************************************************************
- Dim bsTrough, dtjj, dtqq, dtaa, dtkk
- 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 = "Joker Poker (Gottlieb)"&chr(13)&"You Suck"
- .HandleMechanics=0
- .HandleKeyboard=0
- .ShowDMDOnly=1
- .ShowFrame=0
- .ShowTitle=0
- .hidden = 1
- If Err Then MsgBox Err.Description
- End With
- On Error Goto 0
- Controller.SolMask(0)=0
- vpmTimer.AddTimer 2000,"Controller.SolMask(0)=&Hffffffff'" 'ignore all solenoids - then add the timer to renable all the solenoids after 2 seconds
- Controller.Run
- If Err Then MsgBox Err.Description
- On Error Goto 0
- PinMAMETimer.Interval=PinMAMEInterval
- PinMAMETimer.Enabled=1
- vpmNudge.TiltSwitch = 4
- vpmNudge.Sensitivity = 2
- vpmNudge.TiltObj = Array(Bumper1, Bumper2, LeftSlingshot)
- ' Trough
- Set bsTrough = New cvpmBallStack
- bsTrough.initnotrough ballrelease, 66, 90, 10
- ' bsTrough.InitExitSnd "ballrelease","solenoid"
- ' Drop targets
- set dtjj=New cvpmDropTarget
- dtjj.InitDrop Array(sw21,sw22,sw23),Array(21,22,23)
- dtjj.initsnd "DTDrop","DTReset"
- set dtqq=New cvpmDropTarget
- dtqq.InitDrop Array(sw31,sw32,sw33),array(31,32,33)
- dtqq.initsnd "DTDrop","DTReset"
- set dtkk=New cvpmDropTarget
- dtkk.InitDrop Array(sw41,sw42,sw43,sw44),array(41,42,43,44)
- dtkk.initsnd "DTDrop","DTReset"
- set dtaa=New cvpmDropTarget
- dtaa.InitDrop Array(sw50,sw51,sw52,sw53,sw54),array(50,51,52,53,54)
- dtaa.initsnd "DTDrop","DTReset"
- End Sub
- '**********************************************************************************************************
- 'Plunger code
- '**********************************************************************************************************
- Sub Table1_KeyDown(ByVal keycode)
- If vpmKeyDown(KeyCode) Then Exit Sub
- If keycode = LeftFlipperKey Then FlipperActivate LeftFlipper, LFPress
- If keycode = RightFlipperKey Then FlipperActivate RightFlipper, RFPress
- If keycode = LeftMagnaSave Then bLutActive = True
- If keycode = RightMagnaSave Then
- If bLutActive Then NextLUT: End If
- End If
- If KeyCode = PlungerKey Then Plunger.Pullback:SoundPlungerPull()
- If keycode = LeftTiltKey Then Nudge 90, 5:SoundNudgeLeft()
- If keycode = RightTiltKey Then Nudge 270, 5:SoundNudgeRight()
- If keycode = CenterTiltKey Then Nudge 0, 3:SoundNudgeCenter()
- If keycode = keyInsertCoin1 or keycode = keyInsertCoin2 or keycode = keyInsertCoin3 or keycode = keyInsertCoin4 Then
- Select Case Int(rnd*3)
- Case 0: PlaySound ("Coin_In_1"), 0, CoinSoundLevel, 0, 0.25
- Case 1: PlaySound ("Coin_In_2"), 0, CoinSoundLevel, 0, 0.25
- Case 2: PlaySound ("Coin_In_3"), 0, CoinSoundLevel, 0, 0.25
- End Select
- End If
- if keycode=StartGameKey then soundStartButton()
- End Sub
- Sub Table1_KeyUp(ByVal keycode)
- If vpmKeyUp(KeyCode) Then Exit Sub
- If keycode = LeftFlipperKey Then FlipperDeActivate LeftFlipper, LFPress
- If keycode = RightFlipperKey Then FlipperDeActivate RightFlipper, RFPress
- If keycode = LeftMagnaSave Then bLutActive = False
- If KeyCode = PlungerKey Then
- Plunger.Fire
- If BIPL = 1 Then
- SoundPlungerReleaseBall() 'Plunger release sound when there is a ball in shooter lane
- Else
- SoundPlungerReleaseNoBall() 'Plunger release sound when there is no ball in shooter lane
- End If
- End If
- End Sub
- '**********************************************************************************************************
- ' Fleep BIPL
- '**********************************************************************************************************
- Dim BIPL : BIPL=0
- Sub swBIPL_Hit
- BIPL = 1
- End Sub
- Sub swBIPL_UnHit
- BIPL = 0
- End Sub
- '**********************************************************************************************************
- ' Drain hole
- Sub Drain_Hit:bsTrough.addball me:RandomSoundDrain Drain:End Sub
- Sub BallRelease_Unhit:RandomSoundBallRelease BallRelease: End Sub
- ' Bumpers
- Sub Bumper1_Hit:vpmTimer.PulseSw 10 :DOF 201,DOFPulse:RandomSoundBumperTop Bumper1 : End Sub
- Sub Bumper2_Hit:vpmTimer.PulseSw 10 :DOF 202,DOFPulse: RandomSoundBumperMiddle Bumper2: End Sub
- ' Rollovers
- Sub sw11_Hit:Controller.Switch(11) = 1 : End Sub
- Sub sw11_UnHit:Controller.Switch(11) = 0:End Sub
- Sub sw12_Hit:Controller.Switch(12) = 1 : End Sub
- Sub sw12_UnHit:Controller.Switch(12) = 0:End Sub
- Sub sw13_Hit:Controller.Switch(13) = 1 : End Sub
- Sub sw13_UnHit:Controller.Switch(13) = 0:End Sub
- Sub sw30_Hit:Controller.Switch(30) = 1 : End Sub
- Sub sw30_UnHit:Controller.Switch(30) = 0:End Sub
- Sub sw11b_Hit:Controller.Switch(11) = 1 : End Sub
- Sub sw11b_UnHit:Controller.Switch(11) = 0:End Sub
- Sub sw12b_Hit:Controller.Switch(12) = 1 : End Sub
- Sub sw12b_UnHit:Controller.Switch(12) = 0:End Sub
- Sub sw12d_Hit:Controller.Switch(12) = 1 : End Sub
- Sub sw12d_UnHit:Controller.Switch(12) = 0:End Sub
- Sub sw13b_Hit:Controller.Switch(13) = 1 : End Sub
- Sub sw13b_UnHit:Controller.Switch(13) = 0:End Sub
- 'Scoring Rubbers
- Sub sw40a_Slingshot():vpmTimer.PulseSw 40:End Sub
- Sub sw40b_Slingshot():vpmTimer.PulseSw 40:End Sub
- Sub sw40c_Slingshot():vpmTimer.PulseSw 40:End Sub
- Sub sw40d_Slingshot():vpmTimer.PulseSw 40:End Sub
- Sub sw40e_Slingshot():vpmTimer.PulseSw 40:End Sub
- Sub sw40f_Slingshot():vpmTimer.PulseSw 40:End Sub
- Sub sw40g_Slingshot():vpmTimer.PulseSw 40:End Sub
- Sub sw40h_Slingshot():vpmTimer.PulseSw 40:End Sub
- Sub sw40i_Slingshot():vpmTimer.PulseSw 40:End Sub
- Sub sw40j_Slingshot():vpmTimer.PulseSw 40:End Sub
- 'Drop targets
- Sub sw21_Hit:dtjj.Hit 1
- TargetBouncer Activeball, 1
- End Sub
- Sub sw22_Hit:dtjj.Hit 2
- TargetBouncer Activeball, 1
- End Sub
- Sub sw23_Hit:dtjj.Hit 3
- TargetBouncer Activeball, 1
- End Sub
- Sub sw31_Hit:dtqq.Hit 1
- TargetBouncer Activeball, 1
- End Sub
- Sub sw32_Hit:dtqq.Hit 2
- TargetBouncer Activeball, 1
- End Sub
- Sub sw33_Hit:dtqq.Hit 3
- TargetBouncer Activeball, 1
- End Sub
- Sub sw41_Hit:dtkk.Hit 1
- TargetBouncer Activeball, 1
- End Sub
- Sub sw42_Hit:dtkk.Hit 2
- TargetBouncer Activeball, 1
- End Sub
- Sub sw43_Hit:dtkk.Hit 3
- TargetBouncer Activeball, 1
- End Sub
- Sub sw44_Hit:dtkk.Hit 4
- TargetBouncer Activeball, 1
- End Sub
- Sub sw50_Hit:dtaa.Hit 1
- TargetBouncer Activeball, 1
- End Sub
- Sub sw51_Hit:dtaa.Hit 2
- TargetBouncer Activeball, 1
- End Sub
- Sub sw52_Hit:dtaa.Hit 3
- TargetBouncer Activeball, 1
- End Sub
- Sub sw53_Hit:dtaa.Hit 4
- TargetBouncer Activeball, 1
- End Sub
- Sub sw54_Hit:dtaa.Hit 5
- TargetBouncer Activeball, 1
- End Sub
- 'Standup target
- Sub sw20_Hit:vpmTimer.PulseSw 20
- TargetBouncer Activeball, 1
- End Sub
- 'Drop Target Reset with lamp
- Dim N1,O1
- N1=0:O1=0
- Set LampCallback=GetRef("UpdateMultipleLamps")
- Sub UpdateMultipleLamps
- N1=Controller.Lamp(17)
- If N1<>O1 Then
- If N1 Then dtkk.DropSol_On
- O1=N1
- End If
- End Sub
- Set Lights(4)=l4
- Set Lights(8)=l8
- Set Lights(9)=l9
- Set Lights(10)=l10
- Set Lights(11)=l11
- Set Lights(12)=l12
- Set Lights(13)=l13
- Set Lights(14)=l14
- Set Lights(15)=l15
- Set Lights(16)=l16
- Set Lights(18)=l18
- Set Lights(19)=l19
- Set Lights(20)=l20
- Set Lights(21)=l21
- Set Lights(22)=l22
- Set Lights(23)=l23
- Set Lights(24)=l24
- Set Lights(25)=l25
- Set Lights(26)=l26
- Set Lights(27)=l27
- Set Lights(28)=l28
- '**********************************************************************************************************
- ' Backglass Light Displays (7 digit 7 segment displays)
- Dim Digits(28)
- Digits(0)=Array(a00,a01,a02,a03,a04,a05,a06,n,a08)
- Digits(1)=Array(a10,a11,a12,a13,a14,a15,a16,n,a18)
- Digits(2)=Array(a20,a21,a22,a23,a24,a25,a26,n,a28)
- Digits(3)=Array(a30,a31,a32,a33,a34,a35,a36,n,a38)
- Digits(4)=Array(a40,a41,a42,a43,a44,a45,a46,n,a48)
- Digits(5)=Array(a50,a51,a52,a53,a54,a55,a56,n,a58)
- Digits(6)=Array(b20,b21,b22,b23,b24,b25,b26,n,b28)
- Digits(7)=Array(b30,b31,b32,b33,b34,b35,b36,n,b38)
- Digits(8)=Array(b40,b41,b42,b43,b44,b45,b46,n,b48)
- Digits(9)=Array(b50,b51,b52,b53,b54,b55,b56,n,b58)
- Digits(10)=Array(c00,c01,c02,c03,c04,c05,c06,n,c08)
- Digits(11)=Array(c10,c11,c12,c13,c14,c15,c16,n,c18)
- Digits(12)=Array(c20,c21,c22,c23,c24,c25,c26,n,c28)
- Digits(13)=Array(c30,c31,c32,c33,c34,c35,c36,n,c38)
- Digits(14)=Array(c40,c41,c42,c43,c44,c45,c46,n,c48)
- Digits(15)=Array(c50,c51,c52,c53,c54,c55,c56,n,c58)
- Digits(16)=Array(d00,d01,d02,d03,d04,d05,d06,n,d08)
- Digits(17)=Array(d10,d11,d12,d13,d14,d15,d16,n,d18)
- Digits(18)=Array(d40,d41,d42,d43,d44,d45,d46,n,d48)
- Digits(19)=Array(d50,d51,d52,d53,d54,d55,d56,n,d58)
- Digits(20)=Array(e00,e01,e02,e03,e04,e05,e06,n,e08)
- Digits(21)=Array(e10,e11,e12,e13,e14,e15,e16,n,e18)
- Digits(22)=Array(f00,f01,f02,f03,f04,f05,f06,n,f08)
- Digits(23)=Array(f10,f11,f12,f13,f14,f15,f16,n,f18)
- 'credit -- Ball In Play
- Digits(24) = Array(e2,e3,e7,e4,e5,e1,e6,n,e23)
- Digits(25) = Array(e9,e17,e22,e19,e20,e8,e21,n,e24)
- Digits(26) = Array(f2,f3,f7,f4,f5,f1,f6,n,f23)
- Digits(27) = Array(f9,f17,f22,f19,f20,f8,f21,n,f24)
- Sub DisplayTimer_Timer
- Dim ChgLED,ii,num,chg,stat,obj
- 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
- '**********************************************************************************************************
- '**********************************************************************************************************
- 'Gottlieb System 1
- 'added by Inkochnito
- Sub editDips
- Dim vpmDips : Set vpmDips = New cvpmDips
- With vpmDips
- .AddForm 700,400,"System 1 - DIP switches"
- .AddFrame 205,0,190,"Maximum credits",&H00030000,Array("5 credits",0,"8 credits",&H00020000,"10 credits",&H00010000,"15 credits",&H00030000)'dip 17&18
- .AddFrame 0,0,190,"Coin chute control",&H00040000,Array("seperate",0,"same",&H00040000)'dip 19
- .AddFrame 0,46,190,"Game mode",&H00000400,Array("extra ball",0,"replay",&H00000400)'dip 11
- .AddFrame 0,92,190,"High game to date awards",&H00200000,Array("no award",0,"3 replays",&H00200000)'dip 22
- .AddFrame 0,138,190,"Balls per game",&H00000100,Array("5 balls",0,"3 balls",&H00000100)'dip 9
- .AddFrame 0,184,190,"Tilt effect",&H00000800,Array("game over",0,"ball in play only",&H00000800)'dip 12
- .AddChk 205,80,190,Array("Match feature",&H00000200)'dip 10
- .AddChk 205,95,190,Array("Credits displayed",&H00001000)'dip 13
- .AddChk 205,110,190,Array("Play credit button tune",&H00002000)'dip 14
- .AddChk 205,125,190,Array("Play tones when scoring",&H00080000)'dip 20
- .AddChk 205,140,190,Array("Play coin switch tune",&H00400000)'dip 23
- .AddChk 205,155,190,Array("High game to date displayed",&H00100000)'dip 21
- .AddLabel 50,240,300,20,"After hitting OK, press F3 to reset game with new settings."
- .ViewDips
- End With
- End Sub
- Set vpmShowDips = GetRef("editDips")
- '**********************************************************************************************************
- '**********************************************************************************************************
- '**********Sling Shot Animations
- ' Rstep and Lstep are the variables that increment the animation
- '****************
- Dim Lstep
- Sub LeftSlingShot_Slingshot
- vpmTimer.PulseSw 40
- RandomSoundSlingshotLeft SLING2
- LSling.Visible = 0
- LSling1.Visible = 1
- sling2.TransZ = -20
- LStep = 0
- LeftSlingShot.TimerEnabled = 1
- DOF 203,DOFPulse
- 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
- '******************************************************
- ' BALL ROLLING AND DROP SOUNDS
- '******************************************************
- Const tnob = 5 ' total number of balls
- ReDim rolling(tnob)
- InitRolling
- Dim DropCount
- ReDim DropCount(tnob)
- 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("BallRoll_" & 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 ("BallRoll_" & b), -1, VolPlayfieldRoll(BOT(b)) * 1.1 * VolumeDial, AudioPan(BOT(b)), 0, PitchPlayfieldRoll(BOT(b)), 1, 0, AudioFade(BOT(b))
- Else
- If rolling(b) = True Then
- StopSound("BallRoll_" & b)
- rolling(b) = False
- End If
- End If
- '***Ball Drop Sounds***
- If BOT(b).VelZ < -1 and BOT(b).z < 55 and BOT(b).z > 27 Then 'height adjust for ball drop sounds
- If DropCount(b) >= 5 Then
- DropCount(b) = 0
- If BOT(b).velz > -7 Then
- RandomSoundBallBouncePlayfieldSoft BOT(b)
- Else
- RandomSoundBallBouncePlayfieldHard BOT(b)
- End If
- End If
- End If
- If DropCount(b) < 5 Then
- DropCount(b) = DropCount(b) + 1
- End If
- Next
- End Sub
- '*************
- ' JP'S LUT
- '*************
- Dim bLutActive, LUTImage
- Sub LoadLUT
- Dim x
- x = LoadValue(cGameName, "LUTImage")
- If(x <> "") Then LUTImage = x Else LUTImage = 0
- UpdateLUT
- End Sub
- Sub SaveLUT
- SaveValue cGameName, "LUTImage", LUTImage
- End Sub
- Sub NextLUT: LUTImage = (LUTImage +1 ) MOD 10: UpdateLUT: SaveLUT: End Sub
- Sub UpdateLUT
- Select Case LutImage
- Case 0: table1.ColorGradeImage = "LUT0"
- Case 1: table1.ColorGradeImage = "LUT1"
- Case 2: table1.ColorGradeImage = "LUT2"
- Case 3: table1.ColorGradeImage = "LUT3"
- Case 4: table1.ColorGradeImage = "LUT4"
- Case 5: table1.ColorGradeImage = "LUT5"
- Case 6: table1.ColorGradeImage = "LUT6"
- Case 7: table1.ColorGradeImage = "LUT7"
- Case 8: table1.ColorGradeImage = "LUT8"
- Case 9: table1.ColorGradeImage = "LUT9"
- End Select
- End Sub
- '*****************************************
- ' ninuzzu's FLIPPER SHADOWS
- '*****************************************
- sub FlipperTimer_Timer()
- FlipperLSh.RotZ = LeftFlipper.currentangle
- FlipperRSh.RotZ = RightFlipper.currentangle
- Lflip.roty = LeftFlipper.currentangle
- RFlip.roty = RightFlipper.currentangle
- Rflip1.roty = RightFlipper1.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))/21)) + 6
- Else
- BallShadow(b).X = ((BOT(b).X) + (Ballsize/6) + ((BOT(b).X - (Table1.Width/2))/21)) - 6
- End If
- ballShadow(b).Y = BOT(b).Y + 4
- If BOT(b).Z > 20 Then
- BallShadow(b).visible = 1
- Else
- BallShadow(b).visible = 0
- End If
- Next
- End Sub
- '******************************************************
- ' FLIPPER CORRECTION INITIALIZATION
- ' Start nFOZZY FLIPPERS'
- '******************************************************
- 'Flipper Correction Initialization late 80’s to early 90’s
- dim LF : Set LF = New FlipperPolarity
- dim RF : Set RF = New FlipperPolarity
- InitPolarity
- '' Late 70's to early 80's
- Sub InitPolarity()
- dim x, a : a = Array(LF, RF)
- for each x in a
- x.AddPoint "Ycoef", 0, RightFlipper.Y-65, 1 'disabled
- x.AddPoint "Ycoef", 1, RightFlipper.Y-11, 1
- x.enabled = True
- x.TimeDelay = 80
- Next
- AddPt "Polarity", 0, 0, 0
- AddPt "Polarity", 1, 0.05, -2.7
- AddPt "Polarity", 2, 0.33, -2.7
- AddPt "Polarity", 3, 0.37, -2.7
- AddPt "Polarity", 4, 0.41, -2.7
- AddPt "Polarity", 5, 0.45, -2.7
- AddPt "Polarity", 6, 0.576,-2.7
- AddPt "Polarity", 7, 0.66, -1.8
- AddPt "Polarity", 8, 0.743, -0.5
- AddPt "Polarity", 9, 0.81, -0.5
- AddPt "Polarity", 10, 0.88, 0
- addpt "Velocity", 0, 0, 1
- addpt "Velocity", 1, 0.16, 1.06
- addpt "Velocity", 2, 0.41, 1.05
- addpt "Velocity", 3, 0.53, 1'0.982
- addpt "Velocity", 4, 0.702, 0.968
- addpt "Velocity", 5, 0.95, 0.968
- addpt "Velocity", 6, 1.03, 0.945
- LF.Object = LeftFlipper
- LF.EndPoint = EndPointLp
- RF.Object = RightFlipper
- RF.EndPoint = EndPointRp
- End Sub
- '
- Sub TriggerLF_Hit() : LF.Addball activeball : End Sub
- Sub TriggerLF_UnHit() : LF.PolarityCorrect activeball : End Sub
- Sub TriggerRF_Hit() : RF.Addball activeball : End Sub
- Sub TriggerRF_UnHit() : RF.PolarityCorrect activeball : End Sub
- '******************************************************
- ' FLIPPER CORRECTION FUNCTIONS
- '******************************************************
- Sub AddPt(aStr, idx, aX, aY) 'debugger wrapper for adjusting flipper script in-game
- dim a : a = Array(LF, RF)
- dim x : for each x in a
- x.addpoint aStr, idx, aX, aY
- Next
- End Sub
- Class FlipperPolarity
- Public DebugOn, Enabled
- Private FlipAt 'Timer variable (IE 'flip at 723,530ms...)
- Public TimeDelay 'delay before trigger turns off and polarity is disabled TODO set time!
- private Flipper, FlipperStart,FlipperEnd, FlipperEndY, LR, PartialFlipCoef
- Private Balls(20), balldata(20)
- dim PolarityIn, PolarityOut
- dim VelocityIn, VelocityOut
- dim YcoefIn, YcoefOut
- Public Sub Class_Initialize
- redim PolarityIn(0) : redim PolarityOut(0) : redim VelocityIn(0) : redim VelocityOut(0) : redim YcoefIn(0) : redim YcoefOut(0)
- Enabled = True : TimeDelay = 50 : LR = 1: dim x : for x = 0 to uBound(balls) : balls(x) = Empty : set Balldata(x) = new SpoofBall : next
- End Sub
- Public Property let Object(aInput) : Set Flipper = aInput : StartPoint = Flipper.x : End Property
- Public Property Let StartPoint(aInput) : if IsObject(aInput) then FlipperStart = aInput.x else FlipperStart = aInput : end if : End Property
- Public Property Get StartPoint : StartPoint = FlipperStart : End Property
- Public Property Let EndPoint(aInput) : FlipperEnd = aInput.x: FlipperEndY = aInput.y: End Property
- Public Property Get EndPoint : EndPoint = FlipperEnd : End Property
- Public Property Get EndPointY: EndPointY = FlipperEndY : End Property
- Public Sub AddPoint(aChooseArray, aIDX, aX, aY) 'Index #, X position, (in) y Position (out)
- Select Case aChooseArray
- case "Polarity" : ShuffleArrays PolarityIn, PolarityOut, 1 : PolarityIn(aIDX) = aX : PolarityOut(aIDX) = aY : ShuffleArrays PolarityIn, PolarityOut, 0
- Case "Velocity" : ShuffleArrays VelocityIn, VelocityOut, 1 :VelocityIn(aIDX) = aX : VelocityOut(aIDX) = aY : ShuffleArrays VelocityIn, VelocityOut, 0
- Case "Ycoef" : ShuffleArrays YcoefIn, YcoefOut, 1 :YcoefIn(aIDX) = aX : YcoefOut(aIDX) = aY : ShuffleArrays YcoefIn, YcoefOut, 0
- End Select
- if gametime > 100 then Report aChooseArray
- End Sub
- Public Sub Report(aChooseArray) 'debug, reports all coords in tbPL.text
- if not DebugOn then exit sub
- dim a1, a2 : Select Case aChooseArray
- case "Polarity" : a1 = PolarityIn : a2 = PolarityOut
- Case "Velocity" : a1 = VelocityIn : a2 = VelocityOut
- Case "Ycoef" : a1 = YcoefIn : a2 = YcoefOut
- case else :tbpl.text = "wrong string" : exit sub
- End Select
- dim str, x : for x = 0 to uBound(a1) : str = str & aChooseArray & " x: " & round(a1(x),4) & ", " & round(a2(x),4) & vbnewline : next
- tbpl.text = str
- End Sub
- Public Sub AddBall(aBall) : dim x : for x = 0 to uBound(balls) : if IsEmpty(balls(x)) then set balls(x) = aBall : exit sub :end if : Next : End Sub
- Private Sub RemoveBall(aBall)
- dim x : for x = 0 to uBound(balls)
- if TypeName(balls(x) ) = "IBall" then
- if aBall.ID = Balls(x).ID Then
- balls(x) = Empty
- Balldata(x).Reset
- End If
- End If
- Next
- End Sub
- Public Sub Fire()
- Flipper.RotateToEnd
- processballs
- End Sub
- Public Property Get Pos 'returns % position a ball. For debug stuff.
- dim x : for x = 0 to uBound(balls)
- if not IsEmpty(balls(x) ) then
- pos = pSlope(Balls(x).x, FlipperStart, 0, FlipperEnd, 1)
- End If
- Next
- End Property
- Public Sub ProcessBalls() 'save data of balls in flipper range
- FlipAt = GameTime
- dim x : for x = 0 to uBound(balls)
- if not IsEmpty(balls(x) ) then
- balldata(x).Data = balls(x)
- End If
- Next
- PartialFlipCoef = ((Flipper.StartAngle - Flipper.CurrentAngle) / (Flipper.StartAngle - Flipper.EndAngle))
- PartialFlipCoef = abs(PartialFlipCoef-1)
- End Sub
- Private Function FlipperOn() : if gameTime < FlipAt+TimeDelay then FlipperOn = True : End If : End Function 'Timer shutoff for polaritycorrect
- Public Sub PolarityCorrect(aBall)
- if FlipperOn() then
- dim tmp, BallPos, x, IDX, Ycoef : Ycoef = 1
- 'y safety Exit
- if aBall.VelY > -8 then 'ball going down
- RemoveBall aBall
- exit Sub
- end if
- 'Find balldata. BallPos = % on Flipper
- for x = 0 to uBound(Balls)
- if aBall.id = BallData(x).id AND not isempty(BallData(x).id) then
- idx = x
- BallPos = PSlope(BallData(x).x, FlipperStart, 0, FlipperEnd, 1)
- if ballpos > 0.65 then Ycoef = LinearEnvelope(BallData(x).Y, YcoefIn, YcoefOut) 'find safety coefficient 'ycoef' data
- end if
- Next
- If BallPos = 0 Then 'no ball data meaning the ball is entering and exiting pretty close to the same position, use current values.
- BallPos = PSlope(aBall.x, FlipperStart, 0, FlipperEnd, 1)
- if ballpos > 0.65 then Ycoef = LinearEnvelope(aBall.Y, YcoefIn, YcoefOut) 'find safety coefficient 'ycoef' data
- End If
- 'Velocity correction
- if not IsEmpty(VelocityIn(0) ) then
- Dim VelCoef
- : VelCoef = LinearEnvelope(BallPos, VelocityIn, VelocityOut)
- if partialflipcoef < 1 then VelCoef = PSlope(partialflipcoef, 0, 1, 1, VelCoef)
- if Enabled then aBall.Velx = aBall.Velx*VelCoef
- if Enabled then aBall.Vely = aBall.Vely*VelCoef
- End If
- 'Polarity Correction (optional now)
- if not IsEmpty(PolarityIn(0) ) then
- If StartPoint > EndPoint then LR = -1 'Reverse polarity if left flipper
- dim AddX : AddX = LinearEnvelope(BallPos, PolarityIn, PolarityOut) * LR
- if Enabled then aBall.VelX = aBall.VelX + 1 * (AddX*ycoef*PartialFlipcoef)
- 'playsound "fx_knocker"
- End If
- End If
- RemoveBall aBall
- End Sub
- End Class
- '******************************************************
- ' FLIPPER POLARITY AND RUBBER DAMPENER
- ' SUPPORTING FUNCTIONS
- '******************************************************
- ' Used for flipper correction and rubber dampeners
- Sub ShuffleArray(ByRef aArray, byVal offset) 'shuffle 1d array
- dim x, aCount : aCount = 0
- redim a(uBound(aArray) )
- for x = 0 to uBound(aArray) 'Shuffle objects in a temp array
- if not IsEmpty(aArray(x) ) Then
- if IsObject(aArray(x)) then
- Set a(aCount) = aArray(x)
- Else
- a(aCount) = aArray(x)
- End If
- aCount = aCount + 1
- End If
- Next
- if offset < 0 then offset = 0
- redim aArray(aCount-1+offset) 'Resize original array
- for x = 0 to aCount-1 'set objects back into original array
- if IsObject(a(x)) then
- Set aArray(x) = a(x)
- Else
- aArray(x) = a(x)
- End If
- Next
- End Sub
- ' Used for flipper correction and rubber dampeners
- Sub ShuffleArrays(aArray1, aArray2, offset)
- ShuffleArray aArray1, offset
- ShuffleArray aArray2, offset
- End Sub
- ' Used for flipper correction, rubber dampeners, and drop targets
- Function BallSpeed(ball) 'Calculates the ball speed
- BallSpeed = SQR(ball.VelX^2 + ball.VelY^2 + ball.VelZ^2)
- End Function
- ' Used for flipper correction and rubber dampeners
- Function PSlope(Input, X1, Y1, X2, Y2) 'Set up line via two points, no clamping. Input X, output Y
- dim x, y, b, m : x = input : m = (Y2 - Y1) / (X2 - X1) : b = Y2 - m*X2
- Y = M*x+b
- PSlope = Y
- End Function
- ' Used for flipper correction
- Class spoofball
- Public X, Y, Z, VelX, VelY, VelZ, ID, Mass, Radius
- Public Property Let Data(aBall)
- With aBall
- x = .x : y = .y : z = .z : velx = .velx : vely = .vely : velz = .velz
- id = .ID : mass = .mass : radius = .radius
- end with
- End Property
- Public Sub Reset()
- x = Empty : y = Empty : z = Empty : velx = Empty : vely = Empty : velz = Empty
- id = Empty : mass = Empty : radius = Empty
- End Sub
- End Class
- ' Used for flipper correction and rubber dampeners
- Function LinearEnvelope(xInput, xKeyFrame, yLvl)
- dim y 'Y output
- dim L 'Line
- dim ii : for ii = 1 to uBound(xKeyFrame) 'find active line
- if xInput <= xKeyFrame(ii) then L = ii : exit for : end if
- Next
- if xInput > xKeyFrame(uBound(xKeyFrame) ) then L = uBound(xKeyFrame) 'catch line overrun
- Y = pSlope(xInput, xKeyFrame(L-1), yLvl(L-1), xKeyFrame(L), yLvl(L) )
- if xInput <= xKeyFrame(lBound(xKeyFrame) ) then Y = yLvl(lBound(xKeyFrame) ) 'Clamp lower
- if xInput >= xKeyFrame(uBound(xKeyFrame) ) then Y = yLvl(uBound(xKeyFrame) ) 'Clamp upper
- LinearEnvelope = Y
- End Function
- ' Used for drop targets and stand up targets
- Function Atn2(dy, dx)
- dim pi
- pi = 4*Atn(1)
- If dx > 0 Then
- Atn2 = Atn(dy / dx)
- ElseIf dx < 0 Then
- If dy = 0 Then
- Atn2 = pi
- Else
- Atn2 = Sgn(dy) * (pi - Atn(Abs(dy / dx)))
- end if
- ElseIf dx = 0 Then
- if dy = 0 Then
- Atn2 = 0
- else
- Atn2 = Sgn(dy) * pi / 2
- end if
- End If
- End Function
- ' Used for drop targets and flipper tricks
- Function Distance(ax,ay,bx,by)
- Distance = SQR((ax - bx)^2 + (ay - by)^2)
- End Function
- '******************************************************
- ' FLIPPER TRICKS
- '******************************************************
- RightFlipper.timerinterval=1
- Rightflipper.timerenabled=True
- sub RightFlipper_timer()
- FlipperTricks LeftFlipper, LFPress, LFCount, LFEndAngle, LFState
- FlipperTricks RightFlipper, RFPress, RFCount, RFEndAngle, RFState
- FlipperNudge RightFlipper, RFEndAngle, RFEOSNudge, LeftFlipper, LFEndAngle
- FlipperNudge LeftFlipper, LFEndAngle, LFEOSNudge, RightFlipper, RFEndAngle
- end sub
- Dim LFEOSNudge, RFEOSNudge
- Sub FlipperNudge(Flipper1, Endangle1, EOSNudge1, Flipper2, EndAngle2)
- Dim BOT, b
- If abs(Flipper1.currentangle) < abs(Endangle1) + 3 and EOSNudge1 <> 1 Then
- EOSNudge1 = 1
- If Flipper2.currentangle = EndAngle2 Then
- BOT = GetBalls
- For b = 0 to Ubound(BOT)
- If FlipperTrigger(BOT(b).x, BOT(b).y, Flipper1) Then
- 'Debug.Print "ball in flip1. exit"
- exit Sub
- end If
- Next
- For b = 0 to Ubound(BOT)
- If FlipperTrigger(BOT(b).x, BOT(b).y, Flipper2) Then
- 'debug.print "flippernudge!!"
- BOT(b).velx = BOT(b).velx /1.5
- BOT(b).vely = BOT(b).vely - 1
- end If
- Next
- End If
- Else
- If abs(Flipper1.currentangle) > abs(Endangle1) + 30 then EOSNudge1 = 0
- End If
- End Sub
- '*****************
- ' Maths
- '*****************
- Const Pi = 3.1415927
- Function dSin(degrees)
- dsin = sin(degrees * Pi/180)
- End Function
- Function dCos(degrees)
- dcos = cos(degrees * Pi/180)
- End Function
- '*************************************************
- ' Check ball distance from Flipper for Rem
- '*************************************************
- Function Distance(ax,ay,bx,by)
- Distance = SQR((ax - bx)^2 + (ay - by)^2)
- End Function
- Function DistancePL(px,py,ax,ay,bx,by) ' Distance between a point and a line where point is px,py
- DistancePL = ABS((by - ay)*px - (bx - ax) * py + bx*ay - by*ax)/Distance(ax,ay,bx,by)
- End Function
- Function Radians(Degrees)
- Radians = Degrees * PI /180
- End Function
- Function AnglePP(ax,ay,bx,by)
- AnglePP = Atn2((by - ay),(bx - ax))*180/PI
- End Function
- Function DistanceFromFlipper(ballx, bally, Flipper)
- DistanceFromFlipper = DistancePL(ballx, bally, Flipper.x, Flipper.y, Cos(Radians(Flipper.currentangle+90))+Flipper.x, Sin(Radians(Flipper.currentangle+90))+Flipper.y)
- End Function
- Function FlipperTrigger(ballx, bally, Flipper)
- Dim DiffAngle
- DiffAngle = ABS(Flipper.currentangle - AnglePP(Flipper.x, Flipper.y, ballx, bally) - 90)
- If DiffAngle > 180 Then DiffAngle = DiffAngle - 360
- If DistanceFromFlipper(ballx,bally,Flipper) < 48 and DiffAngle <= 90 and Distance(ballx,bally,Flipper.x,Flipper.y) < Flipper.Length Then
- FlipperTrigger = True
- Else
- FlipperTrigger = False
- End If
- End Function
- '*************************************************
- ' End - Check ball distance from Flipper for Rem
- '*************************************************
- dim LFPress, RFPress, LFCount, RFCount
- dim LFState, RFState
- dim EOST, EOSA,Frampup, FElasticity,FReturn
- dim RFEndAngle, LFEndAngle
- EOST = leftflipper.eostorque
- EOSA = leftflipper.eostorqueangle
- Frampup = LeftFlipper.rampup
- FElasticity = LeftFlipper.elasticity
- FReturn = LeftFlipper.return
- Const EOSTnew = 1 '0.8
- Const EOSAnew = 1
- Const EOSRampup = 0
- Dim SOSRampup
- Select Case FlipperCoilRampupMode
- Case 0:
- SOSRampup = 2.5
- Case 1:
- SOSRampup = 4.5
- Case 2:
- SOSRampup = 8.5
- End Select
- Const LiveCatch = 16
- Const LiveElasticity = 0.45
- Const SOSEM = 0.815
- Const EOSReturn = 0.035 '0.025
- LFEndAngle = Leftflipper.endangle
- RFEndAngle = RightFlipper.endangle
- Sub FlipperActivate(Flipper, FlipperPress)
- FlipperPress = 1
- Flipper.Elasticity = FElasticity
- Flipper.eostorque = EOST
- Flipper.eostorqueangle = EOSA
- End Sub
- Sub FlipperDeactivate(Flipper, FlipperPress)
- FlipperPress = 0
- Flipper.eostorqueangle = EOSA
- Flipper.eostorque = EOST*EOSReturn/FReturn
- If Abs(Flipper.currentangle) <= Abs(Flipper.endangle) + 0.1 Then
- Dim BOT, b
- BOT = GetBalls
- For b = 0 to UBound(BOT)
- If Distance(BOT(b).x, BOT(b).y, Flipper.x, Flipper.y) < 55 Then 'check for cradle
- If BOT(b).vely >= -0.4 Then BOT(b).vely = -0.4
- End If
- Next
- End If
- End Sub
- Sub FlipperTricks (Flipper, FlipperPress, FCount, FEndAngle, FState)
- Dim Dir
- Dir = Flipper.startangle/Abs(Flipper.startangle) '-1 for Right Flipper
- If Abs(Flipper.currentangle) > Abs(Flipper.startangle) - 0.05 Then
- If FState <> 1 Then
- Flipper.rampup = SOSRampup
- Flipper.endangle = FEndAngle - 3*Dir
- Flipper.Elasticity = FElasticity * SOSEM
- FCount = 0
- FState = 1
- End If
- ElseIf Abs(Flipper.currentangle) <= Abs(Flipper.endangle) and FlipperPress = 1 then
- if FCount = 0 Then FCount = GameTime
- If FState <> 2 Then
- Flipper.eostorqueangle = EOSAnew
- Flipper.eostorque = EOSTnew
- Flipper.rampup = EOSRampup
- Flipper.endangle = FEndAngle
- FState = 2
- End If
- Elseif Abs(Flipper.currentangle) > Abs(Flipper.endangle) + 0.01 and FlipperPress = 1 Then
- If FState <> 3 Then
- Flipper.eostorque = EOST
- Flipper.eostorqueangle = EOSA
- Flipper.rampup = Frampup
- Flipper.Elasticity = FElasticity
- FState = 3
- End If
- End If
- End Sub
- Const LiveDistanceMin = 30 'minimum distance in vp units from flipper base live catch dampening will occur
- Const LiveDistanceMax = 117 'maximum distance in vp units from flipper base live catch dampening will occur (tip protection)
- Sub CheckLiveCatch(ball, Flipper, FCount, parm) 'Experimental new live catch
- Dim Dir
- Dir = Flipper.startangle/Abs(Flipper.startangle) '-1 for Right Flipper
- Dim LiveCatchBounce 'If live catch is not perfect, it won't freeze ball totally
- Dim CatchTime : CatchTime = GameTime - FCount
- if CatchTime <= LiveCatch and parm > 6 and ABS(Flipper.x - ball.x) > LiveDistanceMin and ABS(Flipper.x - ball.x) < LiveDistanceMax Then
- if CatchTime <= LiveCatch*0.8 Then 'Perfect catch only when catch time happens in the beginning of the window
- LiveCatchBounce = 0
- else
- LiveCatchBounce = Abs((LiveCatch/2) - CatchTime) 'Partial catch when catch happens a bit late
- end If
- 'debug.print "Live catch! Bounce: " & LiveCatchBounce
- If LiveCatchBounce = 0 and ball.velx * Dir > 0 Then ball.velx = 0
- ball.vely = LiveCatchBounce * (16 / LiveCatch) ' Multiplier for inaccuracy bounce
- ball.angmomx= 0
- ball.angmomy= 0
- ball.angmomz= 0
- End If
- End Sub
- '*****************************************************************************************************
- 'END nFOZZY FLIPPERS'
- 'PHYSICS DAMPENERS
- 'These are data mined bounce curves,
- 'dialed in with the in-game elasticity as much as possible to prevent angle / spin issues.
- 'Requires tracking ballspeed to calculate COR
- Sub dPosts_Hit(idx)
- RubbersD.dampen Activeball
- TargetBouncer Activeball, 1
- End Sub
- Sub dSleeves_Hit(idx)
- SleevesD.Dampen Activeball
- TargetBouncer Activeball, 0.7
- End Sub
- dim RubbersD : Set RubbersD = new Dampener 'frubber
- RubbersD.name = "Rubbers"
- RubbersD.debugOn = False 'shows info in textbox "TBPout"
- RubbersD.Print = False 'debug, reports in debugger (in vel, out cor)
- 'cor bounce curve (linear)
- 'for best results, try to match in-game velocity as closely as possible to the desired curve
- 'RubbersD.addpoint 0, 0, 0.935 'point# (keep sequential), ballspeed, CoR (elasticity)
- RubbersD.addpoint 0, 0, 0.96 'point# (keep sequential), ballspeed, CoR (elasticity)
- RubbersD.addpoint 1, 3.77, 0.96
- RubbersD.addpoint 2, 5.76, 0.967 'dont take this as gospel. if you can data mine rubber elasticitiy, please help!
- RubbersD.addpoint 3, 15.84, 0.874
- RubbersD.addpoint 4, 56, 0.64 'there's clamping so interpolate up to 56 at least
- dim SleevesD : Set SleevesD = new Dampener 'this is just rubber but cut down to 85%...
- SleevesD.name = "Sleeves"
- SleevesD.debugOn = False 'shows info in textbox "TBPout"
- SleevesD.Print = False 'debug, reports in debugger (in vel, out cor)
- SleevesD.CopyCoef RubbersD, 0.85
- Class Dampener
- Public Print, debugOn 'tbpOut.text
- public name, Threshold 'Minimum threshold. Useful for Flippers, which don't have a hit threshold.
- Public ModIn, ModOut
- Private Sub Class_Initialize : redim ModIn(0) : redim Modout(0): End Sub
- Public Sub AddPoint(aIdx, aX, aY)
- ShuffleArrays ModIn, ModOut, 1 : ModIn(aIDX) = aX : ModOut(aIDX) = aY : ShuffleArrays ModIn, ModOut, 0
- if gametime > 100 then Report
- End Sub
- public sub Dampen(aBall)
- if threshold then if BallSpeed(aBall) < threshold then exit sub end if end if
- dim RealCOR, DesiredCOR, str, coef
- DesiredCor = LinearEnvelope(cor.ballvel(aBall.id), ModIn, ModOut )
- RealCOR = BallSpeed(aBall) / cor.ballvel(aBall.id)
- coef = desiredcor / realcor
- if debugOn then str = name & " in vel:" & round(cor.ballvel(aBall.id),2 ) & vbnewline & "desired cor: " & round(desiredcor,4) & vbnewline & _
- "actual cor: " & round(realCOR,4) & vbnewline & "ballspeed coef: " & round(coef, 3) & vbnewline
- if Print then debug.print Round(cor.ballvel(aBall.id),2) & ", " & round(desiredcor,3)
- aBall.velx = aBall.velx * coef : aBall.vely = aBall.vely * coef
- if debugOn then TBPout.text = str
- End Sub
- Public Sub CopyCoef(aObj, aCoef) 'alternative addpoints, copy with coef
- dim x : for x = 0 to uBound(aObj.ModIn)
- addpoint x, aObj.ModIn(x), aObj.ModOut(x)*aCoef
- Next
- End Sub
- Public Sub Report() 'debug, reports all coords in tbPL.text
- if not debugOn then exit sub
- dim a1, a2 : a1 = ModIn : a2 = ModOut
- dim str, x : for x = 0 to uBound(a1) : str = str & x & ": " & round(a1(x),4) & ", " & round(a2(x),4) & vbnewline : next
- TBPout.text = str
- End Sub
- End Class
- '******************************************************
- ' TRACK ALL BALL VELOCITIES
- ' FOR RUBBER DAMPENER AND DROP TARGETS
- '******************************************************
- dim cor : set cor = New CoRTracker
- Class CoRTracker
- public ballvel, ballvelx, ballvely
- Private Sub Class_Initialize : redim ballvel(0) : redim ballvelx(0): redim ballvely(0) : End Sub
- Public Sub Update() 'tracks in-ball-velocity
- dim str, b, AllBalls, highestID : allBalls = getballs
- for each b in allballs
- if b.id >= HighestID then highestID = b.id
- Next
- if uBound(ballvel) < highestID then redim ballvel(highestID) 'set bounds
- if uBound(ballvelx) < highestID then redim ballvelx(highestID) 'set bounds
- if uBound(ballvely) < highestID then redim ballvely(highestID) 'set bounds
- for each b in allballs
- ballvel(b.id) = BallSpeed(b)
- ballvelx(b.id) = b.velx
- ballvely(b.id) = b.vely
- Next
- End Sub
- End Class
- Sub RDampen_Timer()
- Cor.Update
- End Sub
- '******************************************************
- ' TargetBouncer for targets and posts by Iaakki, Wrd1972, Apophis
- '******************************************************
- sub TargetBouncer(aBall,defvalue)
- dim zMultiplier, vel, vratio
- if TargetBouncerEnabled <> 0 and aball.z < 30 then
- 'debug.print "velx: " & aball.velx & " vely: " & aball.vely & " velz: " & aball.velz
- vel = BallSpeed(aBall)
- vratio = aBall.vely/aBall.velx
- Select Case Int(Rnd * 6) + 1
- Case 1: zMultiplier = 0.1*defvalue
- Case 2: zMultiplier = 0.2*defvalue
- Case 3: zMultiplier = 0.3*defvalue
- Case 4: zMultiplier = 0.4*defvalue
- Case 5: zMultiplier = 0.5*defvalue
- Case 6: zMultiplier = 0.6*defvalue
- End Select
- aBall.velz = abs(vel * zMultiplier * TargetBouncerFactor)
- aBall.velx = sgn(aBall.velx) * sqr(abs((vel^2 - aBall.velz^2)/(1+vratio^2)))
- aBall.vely = aBall.velx * vratio
- 'debug.print "---> velx: " & aball.velx & " vely: " & aball.vely & " velz: " & aball.velz
- 'debug.print "conservation check: " & BallSpeed(aBall)/vel
- end if
- end sub
- '//////////////////////////// MECHANICAL SOUNDS ///////////////////////////
- '// This part in the script is an entire block that is dedicated to the physics sound system.
- '// Various scripts and sounds that may be pretty generic and could suit other WPC systems, but the most are tailored specifically for this table.
- '/////////////////////////////// SOUNDS PARAMETERS //////////////////////////////
- Dim GlobalSoundLevel, CoinSoundLevel, PlungerReleaseSoundLevel, PlungerPullSoundLevel, NudgeLeftSoundLevel
- Dim NudgeRightSoundLevel, NudgeCenterSoundLevel, StartButtonSoundLevel, RollingSoundFactor
- CoinSoundLevel = 1 'volume level; range [0, 1]
- NudgeLeftSoundLevel = 1 'volume level; range [0, 1]
- NudgeRightSoundLevel = 1 'volume level; range [0, 1]
- NudgeCenterSoundLevel = 1 'volume level; range [0, 1]
- StartButtonSoundLevel = 0.1 'volume level; range [0, 1]
- PlungerReleaseSoundLevel = 0.8 '1 wjr 'volume level; range [0, 1]
- PlungerPullSoundLevel = 1 'volume level; range [0, 1]
- RollingSoundFactor = 1.1/5
- '///////////////////////-----Solenoids, Kickers and Flash Relays-----///////////////////////
- Dim FlipperUpAttackMinimumSoundLevel, FlipperUpAttackMaximumSoundLevel, FlipperUpAttackLeftSoundLevel, FlipperUpAttackRightSoundLevel
- Dim FlipperUpSoundLevel, FlipperDownSoundLevel, FlipperLeftHitParm, FlipperRightHitParm
- Dim SlingshotSoundLevel, BumperSoundFactor, KnockerSoundLevel
- FlipperUpAttackMinimumSoundLevel = 0.010 'volume level; range [0, 1]
- FlipperUpAttackMaximumSoundLevel = 0.635 'volume level; range [0, 1]
- FlipperUpSoundLevel = 1.0 'volume level; range [0, 1]
- FlipperDownSoundLevel = 0.45 'volume level; range [0, 1]
- FlipperLeftHitParm = FlipperUpSoundLevel 'sound helper; not configurable
- FlipperRightHitParm = FlipperUpSoundLevel 'sound helper; not configurable
- SlingshotSoundLevel = 0.95 'volume level; range [0, 1]
- BumperSoundFactor = 4.25 'volume multiplier; must not be zero
- KnockerSoundLevel = 1 'volume level; range [0, 1]
- '///////////////////////-----Ball Drops, Bumps and Collisions-----///////////////////////
- Dim RubberStrongSoundFactor, RubberWeakSoundFactor, RubberFlipperSoundFactor,BallWithBallCollisionSoundFactor
- Dim BallBouncePlayfieldSoftFactor, BallBouncePlayfieldHardFactor, PlasticRampDropToPlayfieldSoundLevel, WireRampDropToPlayfieldSoundLevel, DelayedBallDropOnPlayfieldSoundLevel
- Dim WallImpactSoundFactor, MetalImpactSoundFactor, SubwaySoundLevel, SubwayEntrySoundLevel, ScoopEntrySoundLevel
- Dim SaucerLockSoundLevel, SaucerKickSoundLevel
- BallWithBallCollisionSoundFactor = 3.2 'volume multiplier; must not be zero
- RubberStrongSoundFactor = 0.055/5 'volume multiplier; must not be zero
- RubberWeakSoundFactor = 0.075/5 'volume multiplier; must not be zero
- RubberFlipperSoundFactor = 0.075/5 'volume multiplier; must not be zero
- BallBouncePlayfieldSoftFactor = 0.025 'volume multiplier; must not be zero
- BallBouncePlayfieldHardFactor = 0.025 'volume multiplier; must not be zero
- DelayedBallDropOnPlayfieldSoundLevel = 0.8 'volume level; range [0, 1]
- WallImpactSoundFactor = 0.075 'volume multiplier; must not be zero
- MetalImpactSoundFactor = 0.075/3
- SaucerLockSoundLevel = 0.8
- SaucerKickSoundLevel = 0.8
- '///////////////////////-----Gates, Spinners, Rollovers and Targets-----///////////////////////
- Dim GateSoundLevel, TargetSoundFactor, SpinnerSoundLevel, RolloverSoundLevel, DTSoundLevel
- GateSoundLevel = 0.5/5 'volume level; range [0, 1]
- TargetSoundFactor = 0.0025 * 10 'volume multiplier; must not be zero
- DTSoundLevel = 0.25 'volume multiplier; must not be zero
- RolloverSoundLevel = 0.25 'volume level; range [0, 1]
- '///////////////////////-----Ball Release, Guides and Drain-----///////////////////////
- Dim DrainSoundLevel, BallReleaseSoundLevel, BottomArchBallGuideSoundFactor, FlipperBallGuideSoundFactor
- DrainSoundLevel = 0.8 'volume level; range [0, 1]
- BallReleaseSoundLevel = 1 'volume level; range [0, 1]
- BottomArchBallGuideSoundFactor = 0.2 'volume multiplier; must not be zero
- FlipperBallGuideSoundFactor = 0.015 'volume multiplier; must not be zero
- '///////////////////////-----Loops and Lanes-----///////////////////////
- Dim ArchSoundFactor
- ArchSoundFactor = 0.025/5 'volume multiplier; must not be zero
- '///////////////////////////// SOUND PLAYBACK FUNCTIONS ////////////////////////////
- '///////////////////////////// POSITIONAL SOUND PLAYBACK METHODS ////////////////////////////
- ' Positional sound playback methods will play a sound, depending on the X,Y position of the table element or depending on ActiveBall object position
- ' These are similar subroutines that are less complicated to use (e.g. simply use standard parameters for the PlaySound call)
- ' For surround setup - positional sound playback functions will fade between front and rear surround channels and pan between left and right channels
- ' For stereo setup - positional sound playback functions will only pan between left and right channels
- ' For mono setup - positional sound playback functions will not pan between left and right channels and will not fade between front and rear channels
- ' PlaySound full syntax - PlaySound(string, int loopcount, float volume, float pan, float randompitch, int pitch, bool useexisting, bool restart, float front_rear_fade)
- ' Note - These functions will not work (currently) for walls/slingshots as these do not feature a simple, single X,Y position
- Sub PlaySoundAtLevelStatic(playsoundparams, aVol, tableobj)
- PlaySound playsoundparams, 0, aVol * VolumeDial, AudioPan(tableobj), 0, 0, 0, 0, AudioFade(tableobj)
- End Sub
- Sub PlaySoundAtLevelExistingStatic(playsoundparams, aVol, tableobj)
- PlaySound playsoundparams, 0, aVol * VolumeDial, AudioPan(tableobj), 0, 0, 1, 0, AudioFade(tableobj)
- End Sub
- Sub PlaySoundAtLevelStaticLoop(playsoundparams, aVol, tableobj)
- PlaySound playsoundparams, -1, aVol * VolumeDial, AudioPan(tableobj), 0, 0, 0, 0, AudioFade(tableobj)
- End Sub
- Sub PlaySoundAtLevelStaticRandomPitch(playsoundparams, aVol, randomPitch, tableobj)
- PlaySound playsoundparams, 0, aVol * VolumeDial, AudioPan(tableobj), randomPitch, 0, 0, 0, AudioFade(tableobj)
- End Sub
- Sub PlaySoundAtLevelActiveBall(playsoundparams, aVol)
- PlaySound playsoundparams, 0, aVol * VolumeDial, AudioPan(ActiveBall), 0, 0, 0, 0, AudioFade(ActiveBall)
- End Sub
- Sub PlaySoundAtLevelExistingActiveBall(playsoundparams, aVol)
- PlaySound playsoundparams, 0, aVol * VolumeDial, AudioPan(ActiveBall), 0, 0, 1, 0, AudioFade(ActiveBall)
- End Sub
- Sub PlaySoundAtLeveTimerActiveBall(playsoundparams, aVol, ballvariable)
- PlaySound playsoundparams, 0, aVol * VolumeDial, AudioPan(ballvariable), 0, 0, 0, 0, AudioFade(ballvariable)
- End Sub
- Sub PlaySoundAtLevelTimerExistingActiveBall(playsoundparams, aVol, ballvariable)
- PlaySound playsoundparams, 0, aVol * VolumeDial, AudioPan(ballvariable), 0, 0, 1, 0, AudioFade(ballvariable)
- End Sub
- Sub PlaySoundAtLevelRoll(playsoundparams, aVol, pitch)
- PlaySound playsoundparams, -1, aVol * VolumeDial, AudioPan(tableobj), randomPitch, 0, 0, 0, AudioFade(tableobj)
- End Sub
- ' Previous Positional Sound Subs
- Sub PlaySoundAt(soundname, tableobj)
- PlaySound soundname, 1, 1 * VolumeDial, AudioPan(tableobj), 0,0,0, 1, AudioFade(tableobj)
- End Sub
- Sub PlaySoundAtVol(soundname, tableobj, aVol)
- PlaySound soundname, 1, aVol * VolumeDial, AudioPan(tableobj), 0,0,0, 1, AudioFade(tableobj)
- End Sub
- Sub PlaySoundAtBall(soundname)
- PlaySoundAt soundname, ActiveBall
- End Sub
- Sub PlaySoundAtBallVol (Soundname, aVol)
- Playsound soundname, 1,aVol * VolumeDial, AudioPan(ActiveBall), 0,0,0, 1, AudioFade(ActiveBall)
- End Sub
- Sub PlaySoundAtBallVolM (Soundname, aVol)
- Playsound soundname, 1,aVol * VolumeDial, AudioPan(ActiveBall), 0,0,0, 0, AudioFade(ActiveBall)
- End Sub
- Sub PlaySoundAtVolLoops(sound, tableobj, Vol, Loops)
- PlaySound sound, Loops, Vol * VolumeDial, AudioPan(tableobj), 0,0,0, 1, AudioFade(tableobj)
- End Sub
- ' *********************************************************************
- ' Fleep Supporting Ball & Sound Functions
- ' *********************************************************************
- Dim tablewidth, tableheight : tablewidth = table1.width : tableheight = table1.height
- 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 / tableheight-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 / tablewidth-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)
- End Function
- Function Volz(ball) ' Calculates the volume of the sound based on the ball speed
- Volz = Csng((ball.velz) ^2)
- 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 VolPlayfieldRoll(ball) ' Calculates the roll volume of the sound based on the ball speed
- VolPlayfieldRoll = RollingSoundFactor * 0.0005 * Csng(BallVel(ball) ^3)
- End Function
- Function PitchPlayfieldRoll(ball) ' Calculates the roll pitch of the sound based on the ball speed
- PitchPlayfieldRoll = BallVel(ball) ^2 * 15
- End Function
- Function RndInt(min, max)
- RndInt = Int(Rnd() * (max-min + 1) + min)' Sets a random number integer between min and max
- End Function
- Function RndNum(min, max)
- RndNum = Rnd() * (max-min) + min' Sets a random number between min and max
- End Function
- '///////////////////////////// GENERAL SOUND SUBROUTINES ////////////////////////////
- Sub SoundStartButton()
- PlaySound ("Start_Button"), 0, StartButtonSoundLevel, 0, 0.25
- End Sub
- Sub SoundNudgeLeft()
- PlaySound ("Nudge_" & Int(Rnd*2)+1), 0, NudgeLeftSoundLevel * VolumeDial, -0.1, 0.25
- End Sub
- Sub SoundNudgeRight()
- PlaySound ("Nudge_" & Int(Rnd*2)+1), 0, NudgeRightSoundLevel * VolumeDial, 0.1, 0.25
- End Sub
- Sub SoundNudgeCenter()
- PlaySound ("Nudge_" & Int(Rnd*2)+1), 0, NudgeCenterSoundLevel * VolumeDial, 0, 0.25
- End Sub
- Sub SoundPlungerPull()
- PlaySoundAtLevelStatic ("Plunger_Pull_1"), PlungerPullSoundLevel, Plunger
- End Sub
- Sub SoundPlungerReleaseBall()
- PlaySoundAtLevelStatic ("Plunger_Release_Ball"), PlungerReleaseSoundLevel, Plunger
- End Sub
- Sub SoundPlungerReleaseNoBall()
- PlaySoundAtLevelStatic ("Plunger_Release_No_Ball"), PlungerReleaseSoundLevel, Plunger
- End Sub
- '///////////////////////////// KNOCKER SOLENOID ////////////////////////////
- Sub KnockerSolenoid()
- PlaySoundAtLevelStatic SoundFX("Knocker_1",DOFKnocker), KnockerSoundLevel, KnockerPosition
- End Sub
- '///////////////////////////// DRAIN SOUNDS ////////////////////////////
- Sub RandomSoundDrain(drainswitch)
- PlaySoundAtLevelStatic ("Drain_" & Int(Rnd*11)+1), DrainSoundLevel, drainswitch
- End Sub
- '///////////////////////////// TROUGH BALL RELEASE SOLENOID SOUNDS ////////////////////////////
- Sub RandomSoundBallRelease(drainswitch)
- PlaySoundAtLevelStatic SoundFX("BallRelease" & Int(Rnd*7)+1,DOFContactors), BallReleaseSoundLevel, drainswitch
- End Sub
- '///////////////////////////// SLINGSHOT SOLENOID SOUNDS ////////////////////////////
- Sub RandomSoundSlingshotLeft(sling)
- PlaySoundAtLevelStatic SoundFX("Sling_L" & Int(Rnd*10)+1,DOFContactors), SlingshotSoundLevel, Sling
- End Sub
- Sub RandomSoundSlingshotRight(sling)
- PlaySoundAtLevelStatic SoundFX("Sling_R" & Int(Rnd*8)+1,DOFContactors), SlingshotSoundLevel, Sling
- End Sub
- '///////////////////////////// BUMPER SOLENOID SOUNDS ////////////////////////////
- Sub RandomSoundBumperTop(Bump)
- PlaySoundAtLevelStatic SoundFX("Bumpers_Top_" & Int(Rnd*5)+1,DOFContactors), Vol(ActiveBall) * BumperSoundFactor, Bump
- End Sub
- Sub RandomSoundBumperMiddle(Bump)
- PlaySoundAtLevelStatic SoundFXDOF("Bumpers_Middle_" & Int(Rnd*5)+1, 111, DOFPulse, DOFContactors), Vol(ActiveBall) * BumperSoundFactor, Bump
- End Sub
- Sub RandomSoundBumperBottom(Bump)
- PlaySoundAtLevelStatic SoundFXDOF("Bumpers_Bottom_" & Int(Rnd*5)+1, 112, DOFPulse, DOFContactors), Vol(ActiveBall) * BumperSoundFactor, Bump
- End Sub
- '///////////////////////////// FLIPPER BATS SOUND SUBROUTINES ////////////////////////////
- '///////////////////////////// FLIPPER BATS SOLENOID ATTACK SOUND ////////////////////////////
- Sub SoundFlipperUpAttackLeft(flipper)
- FlipperUpAttackLeftSoundLevel = RndNum(FlipperUpAttackMinimumSoundLevel, FlipperUpAttackMaximumSoundLevel)
- PlaySoundAtLevelStatic ("Flipper_Attack-L01"), FlipperUpAttackLeftSoundLevel, flipper
- End Sub
- Sub SoundFlipperUpAttackRight(flipper)
- FlipperUpAttackRightSoundLevel = RndNum(FlipperUpAttackMinimumSoundLevel, FlipperUpAttackMaximumSoundLevel)
- PlaySoundAtLevelStatic ("Flipper_Attack-R01"), FlipperUpAttackLeftSoundLevel, flipper
- End Sub
- '///////////////////////////// FLIPPER BATS SOLENOID CORE SOUND ////////////////////////////
- Sub RandomSoundFlipperUpLeft(flipper)
- PlaySoundAtLevelStatic SoundFX("Flipper_L0" & Int(Rnd*9)+1,DOFFlippers), FlipperLeftHitParm, Flipper
- End Sub
- Sub RandomSoundFlipperUpRight(flipper)
- PlaySoundAtLevelStatic SoundFX("Flipper_R0" & Int(Rnd*9)+1,DOFFlippers), FlipperRightHitParm, Flipper
- End Sub
- Sub RandomSoundReflipUpLeft(flipper)
- PlaySoundAtLevelStatic SoundFX("Flipper_ReFlip_L0" & Int(Rnd*3)+1,DOFFlippers), (RndNum(0.8, 1))*FlipperUpSoundLevel, Flipper
- End Sub
- Sub RandomSoundReflipUpRight(flipper)
- PlaySoundAtLevelStatic SoundFX("Flipper_ReFlip_R0" & Int(Rnd*3)+1,DOFFlippers), (RndNum(0.8, 1))*FlipperUpSoundLevel, Flipper
- End Sub
- Sub RandomSoundFlipperDownLeft(flipper)
- PlaySoundAtLevelStatic SoundFX("Flipper_Left_Down_" & Int(Rnd*7)+1,DOFFlippers), FlipperDownSoundLevel, Flipper
- End Sub
- Sub RandomSoundFlipperDownRight(flipper)
- PlaySoundAtLevelStatic SoundFX("Flipper_Right_Down_" & Int(Rnd*8)+1,DOFFlippers), FlipperDownSoundLevel, Flipper
- End Sub
- '///////////////////////////// FLIPPER BATS BALL COLLIDE SOUND ////////////////////////////
- Sub LeftFlipperCollide(parm)
- FlipperLeftHitParm = parm/10
- If FlipperLeftHitParm > 1 Then
- FlipperLeftHitParm = 1
- End If
- FlipperLeftHitParm = FlipperUpSoundLevel * FlipperLeftHitParm
- RandomSoundRubberFlipper(parm)
- End Sub
- Sub RightFlipperCollide(parm)
- FlipperRightHitParm = parm/10
- If FlipperRightHitParm > 1 Then
- FlipperRightHitParm = 1
- End If
- FlipperRightHitParm = FlipperUpSoundLevel * FlipperRightHitParm
- RandomSoundRubberFlipper(parm)
- End Sub
- Sub RandomSoundRubberFlipper(parm)
- PlaySoundAtLevelActiveBall ("Flipper_Rubber_" & Int(Rnd*7)+1), parm * RubberFlipperSoundFactor
- End Sub
- '///////////////////////////// ROLLOVER SOUNDS ////////////////////////////
- Sub RandomSoundRollover()
- PlaySoundAtLevelActiveBall ("Rollover_" & Int(Rnd*4)+1), RolloverSoundLevel
- End Sub
- Sub Rollovers_Hit(idx)
- RandomSoundRollover
- End Sub
- '///////////////////////////// VARIOUS PLAYFIELD SOUND SUBROUTINES ////////////////////////////
- '///////////////////////////// RUBBERS AND POSTS ////////////////////////////
- '///////////////////////////// RUBBERS - EVENTS ////////////////////////////
- Sub Rubbers_Hit(idx)
- dim finalspeed
- finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
- If finalspeed > 5 then
- RandomSoundRubberStrong 1
- End if
- If finalspeed <= 5 then
- RandomSoundRubberWeak()
- End If
- End Sub
- '///////////////////////////// RUBBERS AND POSTS - STRONG IMPACTS ////////////////////////////
- Sub RandomSoundRubberStrong(voladj)
- Select Case Int(Rnd*10)+1
- Case 1 : PlaySoundAtLevelActiveBall ("Rubber_Strong_1"), Vol(ActiveBall) * RubberStrongSoundFactor*voladj
- Case 2 : PlaySoundAtLevelActiveBall ("Rubber_Strong_2"), Vol(ActiveBall) * RubberStrongSoundFactor*voladj
- Case 3 : PlaySoundAtLevelActiveBall ("Rubber_Strong_3"), Vol(ActiveBall) * RubberStrongSoundFactor*voladj
- Case 4 : PlaySoundAtLevelActiveBall ("Rubber_Strong_4"), Vol(ActiveBall) * RubberStrongSoundFactor*voladj
- Case 5 : PlaySoundAtLevelActiveBall ("Rubber_Strong_5"), Vol(ActiveBall) * RubberStrongSoundFactor*voladj
- Case 6 : PlaySoundAtLevelActiveBall ("Rubber_Strong_6"), Vol(ActiveBall) * RubberStrongSoundFactor*voladj
- Case 7 : PlaySoundAtLevelActiveBall ("Rubber_Strong_7"), Vol(ActiveBall) * RubberStrongSoundFactor*voladj
- Case 8 : PlaySoundAtLevelActiveBall ("Rubber_Strong_8"), Vol(ActiveBall) * RubberStrongSoundFactor*voladj
- Case 9 : PlaySoundAtLevelActiveBall ("Rubber_Strong_9"), Vol(ActiveBall) * RubberStrongSoundFactor*voladj
- Case 10 : PlaySoundAtLevelActiveBall ("Rubber_1_Hard"), Vol(ActiveBall) * RubberStrongSoundFactor * 0.6*voladj
- End Select
- End Sub
- '///////////////////////////// RUBBERS AND POSTS - WEAK IMPACTS ////////////////////////////
- Sub RandomSoundRubberWeak()
- PlaySoundAtLevelActiveBall ("Rubber_" & Int(Rnd*9)+1), Vol(ActiveBall) * RubberWeakSoundFactor
- End Sub
- '///////////////////////////// WALL IMPACTS ////////////////////////////
- Sub Walls_Hit(idx)
- dim finalspeed
- finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
- If finalspeed > 5 then
- RandomSoundRubberStrong 1
- End if
- If finalspeed <= 5 then
- RandomSoundRubberWeak()
- End If
- End Sub
- Sub RandomSoundWall()
- dim finalspeed
- finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
- If finalspeed > 16 then
- Select Case Int(Rnd*5)+1
- Case 1 : PlaySoundAtLevelExistingActiveBall ("Wall_Hit_1"), Vol(ActiveBall) * WallImpactSoundFactor
- Case 2 : PlaySoundAtLevelExistingActiveBall ("Wall_Hit_2"), Vol(ActiveBall) * WallImpactSoundFactor
- Case 3 : PlaySoundAtLevelExistingActiveBall ("Wall_Hit_5"), Vol(ActiveBall) * WallImpactSoundFactor
- Case 4 : PlaySoundAtLevelExistingActiveBall ("Wall_Hit_7"), Vol(ActiveBall) * WallImpactSoundFactor
- Case 5 : PlaySoundAtLevelExistingActiveBall ("Wall_Hit_9"), Vol(ActiveBall) * WallImpactSoundFactor
- End Select
- End if
- If finalspeed >= 6 AND finalspeed <= 16 then
- Select Case Int(Rnd*4)+1
- Case 1 : PlaySoundAtLevelExistingActiveBall ("Wall_Hit_3"), Vol(ActiveBall) * WallImpactSoundFactor
- Case 2 : PlaySoundAtLevelExistingActiveBall ("Wall_Hit_4"), Vol(ActiveBall) * WallImpactSoundFactor
- Case 3 : PlaySoundAtLevelExistingActiveBall ("Wall_Hit_6"), Vol(ActiveBall) * WallImpactSoundFactor
- Case 4 : PlaySoundAtLevelExistingActiveBall ("Wall_Hit_8"), Vol(ActiveBall) * WallImpactSoundFactor
- End Select
- End If
- If finalspeed < 6 Then
- Select Case Int(Rnd*3)+1
- Case 1 : PlaySoundAtLevelExistingActiveBall ("Wall_Hit_4"), Vol(ActiveBall) * WallImpactSoundFactor
- Case 2 : PlaySoundAtLevelExistingActiveBall ("Wall_Hit_6"), Vol(ActiveBall) * WallImpactSoundFactor
- Case 3 : PlaySoundAtLevelExistingActiveBall ("Wall_Hit_8"), Vol(ActiveBall) * WallImpactSoundFactor
- End Select
- End if
- End Sub
- '///////////////////////////// METAL TOUCH SOUNDS ////////////////////////////
- Sub RandomSoundMetal()
- PlaySoundAtLevelActiveBall ("Metal_Touch_" & Int(Rnd*13)+1), Vol(ActiveBall) * MetalImpactSoundFactor
- End Sub
- '///////////////////////////// METAL - EVENTS ////////////////////////////
- Sub Metals_Hit (idx)
- RandomSoundMetal
- End Sub
- Sub ShooterDiverter_collide(idx)
- RandomSoundMetal
- End Sub
- '///////////////////////////// BOTTOM ARCH BALL GUIDE ////////////////////////////
- '///////////////////////////// BOTTOM ARCH BALL GUIDE - SOFT BOUNCES ////////////////////////////
- Sub RandomSoundBottomArchBallGuide()
- dim finalspeed
- finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
- If finalspeed > 16 then
- PlaySoundAtLevelActiveBall ("Apron_Bounce_"& Int(Rnd*2)+1), Vol(ActiveBall) * BottomArchBallGuideSoundFactor
- End if
- If finalspeed >= 6 AND finalspeed <= 16 then
- Select Case Int(Rnd*2)+1
- Case 1 : PlaySoundAtLevelActiveBall ("Apron_Bounce_1"), Vol(ActiveBall) * BottomArchBallGuideSoundFactor
- Case 2 : PlaySoundAtLevelActiveBall ("Apron_Bounce_Soft_1"), Vol(ActiveBall) * BottomArchBallGuideSoundFactor
- End Select
- End If
- If finalspeed < 6 Then
- Select Case Int(Rnd*2)+1
- Case 1 : PlaySoundAtLevelActiveBall ("Apron_Bounce_Soft_1"), Vol(ActiveBall) * BottomArchBallGuideSoundFactor
- Case 2 : PlaySoundAtLevelActiveBall ("Apron_Medium_3"), Vol(ActiveBall) * BottomArchBallGuideSoundFactor
- End Select
- End if
- End Sub
- '///////////////////////////// BOTTOM ARCH BALL GUIDE - HARD HITS ////////////////////////////
- Sub RandomSoundBottomArchBallGuideHardHit()
- PlaySoundAtLevelActiveBall ("Apron_Hard_Hit_" & Int(Rnd*3)+1), BottomArchBallGuideSoundFactor * 0.25
- End Sub
- Sub Apron_Hit (idx)
- If Abs(cor.ballvelx(activeball.id) < 4) and cor.ballvely(activeball.id) > 7 then
- RandomSoundBottomArchBallGuideHardHit()
- Else
- RandomSoundBottomArchBallGuide
- End If
- End Sub
- '///////////////////////////// FLIPPER BALL GUIDE ////////////////////////////
- Sub RandomSoundFlipperBallGuide()
- dim finalspeed
- finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
- If finalspeed > 16 then
- Select Case Int(Rnd*2)+1
- Case 1 : PlaySoundAtLevelActiveBall ("Apron_Hard_1"), Vol(ActiveBall) * FlipperBallGuideSoundFactor
- Case 2 : PlaySoundAtLevelActiveBall ("Apron_Hard_2"), Vol(ActiveBall) * 0.8 * FlipperBallGuideSoundFactor
- End Select
- End if
- If finalspeed >= 6 AND finalspeed <= 16 then
- PlaySoundAtLevelActiveBall ("Apron_Medium_" & Int(Rnd*3)+1), Vol(ActiveBall) * FlipperBallGuideSoundFactor
- End If
- If finalspeed < 6 Then
- PlaySoundAtLevelActiveBall ("Apron_Soft_" & Int(Rnd*7)+1), Vol(ActiveBall) * FlipperBallGuideSoundFactor
- End If
- End Sub
- '///////////////////////////// TARGET HIT SOUNDS ////////////////////////////
- Sub RandomSoundTargetHitStrong()
- PlaySoundAtLevelActiveBall SoundFX("Target_Hit_" & Int(Rnd*4)+5,DOFTargets), Vol(ActiveBall) * 0.45 * TargetSoundFactor
- End Sub
- Sub RandomSoundTargetHitWeak()
- PlaySoundAtLevelActiveBall SoundFX("Target_Hit_" & Int(Rnd*4)+1,DOFTargets), Vol(ActiveBall) * TargetSoundFactor
- End Sub
- Sub PlayTargetSound()
- dim finalspeed
- finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
- If finalspeed > 10 then
- RandomSoundTargetHitStrong()
- RandomSoundBallBouncePlayfieldSoft Activeball
- Else
- RandomSoundTargetHitWeak()
- End If
- End Sub
- Sub Targets_Hit (idx)
- PlayTargetSound
- End Sub
- '///////////////////////////// BALL BOUNCE SOUNDS ////////////////////////////
- Sub RandomSoundBallBouncePlayfieldSoft(aBall)
- Select Case Int(Rnd*9)+1
- Case 1 : PlaySoundAtLevelStatic ("Ball_Bounce_Playfield_Soft_1"), volz(aBall) * BallBouncePlayfieldSoftFactor, aBall
- Case 2 : PlaySoundAtLevelStatic ("Ball_Bounce_Playfield_Soft_2"), volz(aBall) * BallBouncePlayfieldSoftFactor * 0.5, aBall
- Case 3 : PlaySoundAtLevelStatic ("Ball_Bounce_Playfield_Soft_3"), volz(aBall) * BallBouncePlayfieldSoftFactor * 0.8, aBall
- Case 4 : PlaySoundAtLevelStatic ("Ball_Bounce_Playfield_Soft_4"), volz(aBall) * BallBouncePlayfieldSoftFactor * 0.5, aBall
- Case 5 : PlaySoundAtLevelStatic ("Ball_Bounce_Playfield_Soft_5"), volz(aBall) * BallBouncePlayfieldSoftFactor, aBall
- Case 6 : PlaySoundAtLevelStatic ("Ball_Bounce_Playfield_Hard_1"), volz(aBall) * BallBouncePlayfieldSoftFactor * 0.2, aBall
- Case 7 : PlaySoundAtLevelStatic ("Ball_Bounce_Playfield_Hard_2"), volz(aBall) * BallBouncePlayfieldSoftFactor * 0.2, aBall
- Case 8 : PlaySoundAtLevelStatic ("Ball_Bounce_Playfield_Hard_5"), volz(aBall) * BallBouncePlayfieldSoftFactor * 0.2, aBall
- Case 9 : PlaySoundAtLevelStatic ("Ball_Bounce_Playfield_Hard_7"), volz(aBall) * BallBouncePlayfieldSoftFactor * 0.3, aBall
- End Select
- End Sub
- Sub RandomSoundBallBouncePlayfieldHard(aBall)
- PlaySoundAtLevelStatic ("Ball_Bounce_Playfield_Hard_" & Int(Rnd*7)+1), volz(aBall) * BallBouncePlayfieldHardFactor, aBall
- End Sub
- '///////////////////////////// DELAYED DROP - TO PLAYFIELD - SOUND ////////////////////////////
- Sub RandomSoundDelayedBallDropOnPlayfield(aBall)
- Select Case Int(Rnd*5)+1
- Case 1 : PlaySoundAtLevelStatic ("Ball_Drop_Playfield_1_Delayed"), DelayedBallDropOnPlayfieldSoundLevel, aBall
- Case 2 : PlaySoundAtLevelStatic ("Ball_Drop_Playfield_2_Delayed"), DelayedBallDropOnPlayfieldSoundLevel, aBall
- Case 3 : PlaySoundAtLevelStatic ("Ball_Drop_Playfield_3_Delayed"), DelayedBallDropOnPlayfieldSoundLevel, aBall
- Case 4 : PlaySoundAtLevelStatic ("Ball_Drop_Playfield_4_Delayed"), DelayedBallDropOnPlayfieldSoundLevel, aBall
- Case 5 : PlaySoundAtLevelStatic ("Ball_Drop_Playfield_5_Delayed"), DelayedBallDropOnPlayfieldSoundLevel, aBall
- End Select
- End Sub
- '///////////////////////////// BALL GATES AND BRACKET GATES SOUNDS ////////////////////////////
- Sub SoundPlayfieldGate()
- PlaySoundAtLevelStatic ("Gate_FastTrigger_" & Int(Rnd*2)+1), GateSoundLevel, Activeball
- End Sub
- Sub SoundHeavyGate()
- PlaySoundAtLevelStatic ("Gate_2"), GateSoundLevel, Activeball
- End Sub
- Sub Gates_hit(idx)
- SoundHeavyGate
- End Sub
- Sub GatesWire_hit(idx)
- SoundPlayfieldGate
- End Sub
- '///////////////////////////// LEFT LANE ENTRANCE - SOUNDS ////////////////////////////
- Sub RandomSoundLeftArch()
- PlaySoundAtLevelActiveBall ("Arch_L" & Int(Rnd*4)+1), Vol(ActiveBall) * ArchSoundFactor
- End Sub
- Sub RandomSoundRightArch()
- PlaySoundAtLevelActiveBall ("Arch_R" & Int(Rnd*4)+1), Vol(ActiveBall) * ArchSoundFactor
- End Sub
- Sub Arch1_hit()
- If Activeball.velx > 1 Then SoundPlayfieldGate
- StopSound "Arch_L1"
- StopSound "Arch_L2"
- StopSound "Arch_L3"
- StopSound "Arch_L4"
- End Sub
- Sub Arch1_unhit()
- If activeball.velx < -8 Then
- RandomSoundRightArch
- End If
- End Sub
- Sub Arch2_hit()
- If Activeball.velx < 1 Then SoundPlayfieldGate
- StopSound "Arch_R1"
- StopSound "Arch_R2"
- StopSound "Arch_R3"
- StopSound "Arch_R4"
- End Sub
- Sub Arch2_unhit()
- If activeball.velx > 10 Then
- RandomSoundLeftArch
- End If
- End Sub
- '///////////////////////////// SAUCERS (KICKER HOLES) ////////////////////////////
- Sub SoundSaucerLock()
- PlaySoundAtLevelStatic ("Saucer_Enter_" & Int(Rnd*2)+1), SaucerLockSoundLevel, Activeball
- End Sub
- Sub SoundSaucerKick(scenario, saucer)
- Select Case scenario
- Case 0: PlaySoundAtLevelStatic SoundFX("Saucer_Empty", DOFContactors), SaucerKickSoundLevel, saucer
- Case 1: PlaySoundAtLevelStatic SoundFX("Saucer_Kick", DOFContactors), SaucerKickSoundLevel, saucer
- End Select
- End Sub
- '///////////////////////////// BALL COLLISION SOUND ////////////////////////////
- Sub OnBallBallCollision(ball1, ball2, velocity)
- Dim snd
- Select Case Int(Rnd*7)+1
- Case 1 : snd = "Ball_Collide_1"
- Case 2 : snd = "Ball_Collide_2"
- Case 3 : snd = "Ball_Collide_3"
- Case 4 : snd = "Ball_Collide_4"
- Case 5 : snd = "Ball_Collide_5"
- Case 6 : snd = "Ball_Collide_6"
- Case 7 : snd = "Ball_Collide_7"
- End Select
- PlaySound (snd), 0, Csng(velocity) ^2 / 200 * BallWithBallCollisionSoundFactor * VolumeDial, AudioPan(ball1), 0, Pitch(ball1), 0, 0, AudioFade(ball1)
- End Sub
- '/////////////////////////////////////////////////////////////////
- ' End Mechanical Sounds
- '/////////////////////////////////////////////////////////////////
- ' Thalamus : Exit in a clean and proper way
- Sub Table1_exit()
- If B2SOn Then
- Controller.Pause = False
- Controller.Stop
- End If
- End Sub
Add Comment
Please, Sign In to add comment