From f05f13295e14cc5d23a87e7976c94172eb30ddad Mon Sep 17 00:00:00 2001 From: Francis De Brabandere Date: Mon, 23 Dec 2024 11:10:57 +0100 Subject: [PATCH] Delete Pole Position (Sonic 1987)2.0 directory In the next version the patch is no longer be required --- .../Pole Position (Sonic 1987)2.0.vbs | 3593 ----------------- ...Pole Position (Sonic 1987)2.0.vbs.original | 3568 ---------------- .../Pole Position (Sonic 1987)2.0.vbs.patch | 97 - 3 files changed, 7258 deletions(-) delete mode 100644 Pole Position (Sonic 1987)2.0/Pole Position (Sonic 1987)2.0.vbs delete mode 100644 Pole Position (Sonic 1987)2.0/Pole Position (Sonic 1987)2.0.vbs.original delete mode 100644 Pole Position (Sonic 1987)2.0/Pole Position (Sonic 1987)2.0.vbs.patch diff --git a/Pole Position (Sonic 1987)2.0/Pole Position (Sonic 1987)2.0.vbs b/Pole Position (Sonic 1987)2.0/Pole Position (Sonic 1987)2.0.vbs deleted file mode 100644 index 24ec7ca..0000000 --- a/Pole Position (Sonic 1987)2.0/Pole Position (Sonic 1987)2.0.vbs +++ /dev/null @@ -1,3593 +0,0 @@ -' *********************************************************************** -' ____ ___ _ _____ ____ ___ ____ ___ _____ ___ ___ _ _ -' | _ \ / _ \ | | | ____| | _ \ / _ \ / ___| |_ _| |_ _| |_ _| / _ \ | \ | | -' | |_) | | | | | | | | _| | |_) | | | | | \___ \ | | | | | | | | | | | \| | -' | __/ | |_| | | |___ | |___ | __/ | |_| | ___) | | | | | | | | |_| | | |\ | -' |_| \___/ |_____| |_____| |_| \___/ |____/ |___| |_| |___| \___/ |_| \_| -' -' *********************************************************************** -' Pole Position (Sonic 1987) -' **** -' -' Pole Position / IPD No. 3322 / 1987 / 4 Players -' Solid State Electronic (SS) -' VPX version by NestorGian. Build in 08/2022, version 1.0 -' Art:Pedator (plaifield and plastics) -' Akiles (backglass image) - -' *********************************************************************** -' - nFozzy Physics, FleepSounds, DropTargets by Rothbaurw -' - Dynamic Ballshadows, Slingshot Corrections, LUT selector -' *********************************************************************** - - Option Explicit - Randomize - -'******************************************* -' User Options -'******************************************* - -'----- Shadow Options ----- -Const DynamicBallShadowsOn = 1 '0 = no dynamic ball shadow ("triangles" near slings and such), 1 = enable dynamic ball shadow -Const AmbientBallShadowOn = 1 '0 = Static shadow under ball ("flasher" image, like JP's) - '1 = Moving ball shadow ("primitive" object, like ninuzzu's) - This is the only one that shows up on the pf when in ramps and fades when close to lights! - '2 = flasher image shadow, but it moves like ninuzzu's - -'----- General Sound Options ----- -Const VolumeDial = 0.8 'Overall Mechanical sound effect volume. Recommended values should be no greater than 1. -Const BallRollVolume = 0.6 'Level of ball rolling volume. Value between 0 and 1 -Const RampRollVolume = 0.8 'Level of ramp rolling volume. Value between 0 and 1 - - -'******************************************* -' Constants and Global Variables -'******************************************* - -Const UsingROM = True 'The UsingROM flag is to indicate code that requires ROM usage. Mostly for instructional purposes only. - -Const BallSize = 50 'Ball size must be 50 -Const BallMass = 1 'Ball mass must be 1 -Const tnob = 1 'Total number of balls -Const lob = 0 'Locked balls - -Dim tablewidth: tablewidth = Table1.width -Dim tableheight: tableheight = Table1.height - -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 "01560000", "peyper.vbs", 3.26 - -Const cgamename = "poleposn", UseSolenoids=2, UseLamps=0,UseGI=0, SCoin="coin" - - -If Table1.ShowDT = true then - For each x in aReels - x.Visible = 1 - Next -else - For each x in aReels - x.Visible = 0 - Next -end if - -Dim LUTset, DisableLUTSelector, LutToggleSound, LutToggleSoundLevel -LutToggleSound = True -LutToggleSoundLevel = .1 - -LoadLUT - -'LUTset = 17 ' Override saved LUT for debug - -SetLUT -ShowLUT_Init - -DisableLUTSelector = 0 ' Disables the ability to change LUT option with magna saves in game when set to 1 - - - -'************************************************************* -'Solenoid Call backs -'********************************************************************************************************** - -'SolCallback(1)="vpmSolSound ""bumper""," -'SolCallback(2)="vpmSolSound ""bumper""," -'SolCallback(3)="vpmSolSound ""Slingshot""," -'SolCallback(4)="vpmSolSound ""Slingshot""," - SolCallback(7) = "SolKnocker" 'Credit Knocker - SolCallback(8) = "solrelease" - SolCallback(30) = "vpmNudge.SolGameOn" - SolCallback(31) = "PFGI" - - SolCallback(sLRFlipper) = "SolRFlipper" - SolCallback(sLLFlipper) = "SolLFlipper" - - - -'******************************************* -' Flippers -'******************************************* - -Const ReflipAngle = 20 - -' Flipper Solenoid Callbacks (these subs mimics how you would handle flippers in ROM based tables) -Sub SolLFlipper(Enabled) - If Enabled Then - LF.Fire '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 - - If rightflipper.currentangle > rightflipper.endangle - ReflipAngle Then - RandomSoundReflipUpRight RightFlipper - Else - SoundFlipperUpAttackRight RightFlipper - RandomSoundFlipperUpRight RightFlipper - End If - Else - RightFlipper.RotateToStart - If RightFlipper.currentangle > RightFlipper.startAngle + 5 Then - RandomSoundFlipperDownRight RightFlipper - End If - FlipperRightHitParm = FlipperUpSoundLevel - End If -End Sub - - -' Flipper collide subs -Sub LeftFlipper_Collide(parm) - CheckLiveCatch Activeball, LeftFlipper, LFCount, parm - LeftFlipperCollide parm -End Sub - -Sub RightFlipper_Collide(parm) - CheckLiveCatch Activeball, RightFlipper, RFCount, parm - RightFlipperCollide parm -End Sub - - -' This subroutine updates the flipper shadows and visual primitives -Sub FlipperVisualUpdate - FlipperLSh.RotZ = LeftFlipper.CurrentAngle - FlipperRSh.RotZ = RightFlipper.CurrentAngle -End Sub - - - -'********************************************************************************************************** -'GI -'********************************************************************************************************** - -dim gilvl:gilvl = 1 'General Illumination light state tracked for Dynamic Ball Shadows - -Sub PFGI(Enabled) - If Enabled Then - dim xx - For each xx in GI:xx.State = 0: Next - FlasherGI.visible = 0 - gilvl = 0 - Else - For each xx in GI:xx.State = 1: Next - FlasherGI.visible = 1 - gilvl = 1 - End If - Sound_GI_Relay enabled, bumper1 -End Sub - - -'******************************************* -' Timers -'******************************************* - - -Sub GameTimer_Timer - Cor.Update 'update ball tracking (this sometimes goes in the RDampen_Timer sub) - RollingUpdate 'update rolling sounds - DoSTAnim 'handle stand up target animations -End Sub - -' The frame timer interval is -1, so executes at the display frame rate -dim FrameTime, InitFrameTime : InitFrameTime = 0 - -Sub FrameTimer_Timer() - FrameTime = gametime - InitFrameTime : InitFrameTime = gametime 'Count frametime - FlipperVisualUpdate 'update flipper shadows and primitives - If DynamicBallShadowsOn Or AmbientBallShadowOn Then DynamicBSUpdate 'update ball shadows -End Sub - - -'******************************************* -' Table Initialization and Exiting -'******************************************* - - Dim bsTrough - Dim x, ii - Dim PPBall1, BOT - -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 = "Pole Position - Sonic 1987"&chr(13)&"IT'S FREE" - .HandleMechanics=0 - .HandleKeyboard=0 - .ShowDMDOnly=1 - .ShowFrame=0 - .ShowTitle=0 - .hidden = 1 - Games(cGameName).Settings.Value("sound")=1 - '.PuPHide = 1 - On Error Resume Next - .Run GetPlayerHWnd - If Err Then MsgBox Err.Description - On Error Goto 0 - End With - On Error Goto 0 - - vpmNudge.TiltSwitch = - 5 - vpmNudge.Sensitivity = 5 - vpmNudge.TiltObj = Array(bumper1, bumper2, LeftSlingshot, RightSlingshot) - - - Set PPBall1 = Drain.CreateSizedballWithMass(Ballsize/2,Ballmass) - Controller.Switch(0.1) = 1 - - - ' Main Timer init - PinMAMETimer.Interval = PinMAMEInterval - PinMAMETimer.Enabled = 1 - GameTimer.Enabled = 1 - -' For x = 1 to 78 : DisplayLamps x, 0 : Next -' Leds.Enabled = 1 - LoadLUT - End Sub - - Sub table1_Paused : Controller.Pause = 1 : End Sub - Sub table1_unPaused : Controller.Pause = 0 : End Sub - Sub table1_exit:Controller.Pause = False:Controller.Stop:SaveLUT:End Sub - - - -'******************************************* -' Drain -'******************************************* - - - -' DRAIN & RELEASE -Sub Drain_Hit - RandomSoundDrain Drain - Controller.Switch(0.1) = 1 -' bsTrough.AddBall Me -End Sub - -Sub SolRelease(enabled) - If enabled Then - RandomSoundBallRelease Drain - Drain.kick 60, 20 - Controller.Switch(0.1) = 0 - End If -End Sub - - - '********** - ' Keys - '********** -Dim BIPL : BIPL = 0 - -Sub table1_KeyDown(ByVal Keycode) - - If keycode = LeftFlipperKey Then - FlipperActivate LeftFlipper, LFPress - Controller.Switch(103) = 1 - End If - - If keycode = RightFlipperKey Then - FlipperActivate RightFlipper, RFPress - Controller.Switch(101) = 1 - End If - - If keycode = LeftTiltKey Then Nudge 90, 1:SoundNudgeLeft() - If keycode = RightTiltKey Then Nudge 270, 1:SoundNudgeRight() - If keycode = CenterTiltKey Then Nudge 0, 1:SoundNudgeCenter() - If keycode = StartGameKey then SoundStartButton() - 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 = PlungerKey Then - Plunger.Pullback - SoundPlungerPull() - End if -' iluminación - If keycode = RightMagnaSave Then 'AXS 'Fleep - if DisableLUTSelector = 0 then - If LutToggleSound Then - Playsound "click", 0, LutToggleSoundLevel * VolumeDial, 0, 0.2, 0, 0, 0, 1 - End If - LUTSet = LUTSet + 1 - if LutSet > 17 then LUTSet = 0 - SetLUT - ShowLUT - end if - end if - If keycode = LeftMagnaSave Then - if DisableLUTSelector = 0 then - If LutToggleSound Then - Playsound "click", 0, LutToggleSoundLevel * VolumeDial, 0, 0.2, 0, 0, 0, 1 - End If - LUTSet = LUTSet - 1 - if LutSet < 0 then LUTSet = 17 - SetLUT - ShowLUT - end if - End If - If KeyDownHandler(KeyCode) Then Exit Sub -' If vpmKeyDown(keycode) Then Exit Sub - End Sub - - Sub table1_KeyUp(ByVal Keycode) - - If keycode = LeftFlipperKey Then - FlipperDeActivate LeftFlipper, LFPress - Controller.Switch(103) = 0 - End If - - If keycode = RightFlipperKey Then - FlipperDeActivate RightFlipper, RFPress - Controller.Switch(101) = 0 - End If - -' If keycode = PlungerKey Then Plunger.Fire:PlaySound"plunger" - 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 - - If vpmKeyUp(keycode) Then Exit Sub - End Sub - - - '********* - ' Switches - '********* - - -'**************************************************************** -' Slingshots -'**************************************************************** - -' RStep and LStep are the variables that increment the animation -Dim RStep, LStep, GStep - -Sub RightSlingShot_Slingshot - vpmTimer.PulseSw 3 'Slingshot Rom Switch - RS.VelocityCorrect(ActiveBall) - RSling1.Visible = 1 - Sling1.TransY = -20 'Sling Metal Bracket - RStep = 0 - RightSlingShot.TimerEnabled = 1 - RightSlingShot.TimerInterval = 1 - RandomSoundSlingshotRight Sling1 -End Sub - -Sub RightSlingShot_Timer - Select Case RStep - Case 3:RSLing1.Visible = 0:RSLing2.Visible = 1:Sling1.TransY = -10 - Case 4:RSLing2.Visible = 0:Sling1.TransY = 0:RightSlingShot.TimerEnabled = 0 - End Select - RStep = RStep + 1 -End Sub - -Sub LeftSlingShot_Slingshot - vpmTimer.PulseSw 4 'Slingshot Rom Switch - LS.VelocityCorrect(ActiveBall) - LSling1.Visible = 1 - Sling2.TransY = -20 'Sling Metal Bracket - LStep = 0 - LeftSlingShot.TimerEnabled = 1 - LeftSlingShot.TimerInterval = 10 - RandomSoundSlingshotLeft Sling2 -End Sub - -Sub LeftSlingShot_Timer - Select Case LStep - Case 3:LSLing1.Visible = 0:LSLing2.Visible = 1:Sling2.TransY = -10 - Case 4:LSLing2.Visible = 0:Sling2.TransY = 0:LeftSlingShot.TimerEnabled = 0 - End Select - LStep = LStep + 1 -End Sub - -Sub TestSlingShot_Slingshot - TS.VelocityCorrect(ActiveBall) -End Sub - - - - - -' Rubber Walls -Sub sw12a_Slingshot : PlaySound "Rubber" : vpmTimer.PulseSw 21 : End Sub -Sub sw12b_Slingshot : PlaySound "Rubber" : vpmTimer.PulseSw 21 : End Sub -Sub sw2a_Slingshot : PlaySound "Rubber" : vpmTimer.PulseSw 10 : End Sub -Sub sw2b_Slingshot : PlaySound "Rubber" : vpmTimer.PulseSw 10 : End Sub - - ' Bumpers - -Sub Bumper1_Hit : vpmTimer.PulseSw(2) : RandomSoundBumperTop bumper1: End Sub -Sub Bumper2_Hit : vpmTimer.PulseSw(1) : RandomSoundBumperMiddle bumper2: End Sub - - -' Drain holes & saucers - - - ' Rollovers - Sub sw26_Hit :Controller.Switch(37) = 1 :sw26wire.RotX = 15 :ActivarFreno1: End Sub - Sub sw26_UnHit:Controller.Switch(37) = 0 :sw26wire.RotX = 0 : End Sub - - Sub sw27_Hit :Controller.Switch(36) = 1 :sw27wire.RotX = 15 : End Sub - Sub sw27_UnHit:Controller.Switch(36) = 0 :sw27wire.RotX = 0 : End Sub - - Sub sw30_Hit :Controller.Switch(26) = 1 :sw30wire.RotX = 15 : End Sub - Sub sw30_UnHit:Controller.Switch(26) = 0 :sw30wire.RotX = 0 : End Sub - - Sub sw31_Hit :Controller.Switch(27) = 1 :sw31wire.RotX = 15 :ActivarFreno1: End Sub - Sub sw31_UnHit:Controller.Switch(27) = 0 :sw31wire.RotX = 0 : End Sub - - Sub sw24b_Hit :Controller.Switch(35) = 1 :sw24bwire.RotX = 15 : End Sub - Sub sw24b_UnHit:Controller.Switch(35) = 0 :sw24bwire.RotX = 0 : End Sub - - Sub sw24a_Hit :Controller.Switch(35) = 1 :sw24awire.RotX = 15 : End Sub - Sub sw24a_UnHit:Controller.Switch(35) = 0 :sw24awire.RotX = 0 : End Sub - - Sub sw16_Hit :Controller.Switch(34) = 1 :sw16wire.RotX = 15 : End Sub - Sub sw16_UnHit:Controller.Switch(34) = 0 :sw16wire.RotX = 0 : End Sub - - Sub sw15_Hit :Controller.Switch(24) = 1 :sw15wire.RotX = 15 : End Sub - Sub sw15_UnHit:Controller.Switch(24) = 0 :sw15wire.RotX = 0 : End Sub - - Sub sw3_Hit :Controller.Switch(11) = 1 :sw3wire.RotX = 15 : End Sub - Sub sw3_UnHit:Controller.Switch(11) = 0 :sw3wire.RotX = 0 : End Sub - - Sub sw4_Hit :Controller.Switch(12) = 1 :sw4wire.RotX = 15 : End Sub - Sub sw4_UnHit:Controller.Switch(12) = 0 :sw4wire.RotX = 0 : End Sub - - Sub sw5_Hit :Controller.Switch(13) = 1 :sw5wire.RotX = 15 : End Sub - Sub sw5_UnHit:Controller.Switch(13) = 0 :sw5wire.RotX = 0 : End Sub - - Sub sw1_Hit :Controller.Switch(6) = 1 :sw1wire.RotX = 15 : End Sub - Sub sw1_UnHit:Controller.Switch(6) = 0 :sw1wire.RotX = 0 : End Sub - -Sub Gate4_Hit :ActivarFreno2: End Sub -Sub Gate5_Hit :ActivarFreno2: End Sub - -Sub ActivarFreno1() - If ActiveBall.VelY > 7 then ActiveBall.VelY = 7 - End Sub - - Sub ActivarFreno2() - If ActiveBall.VelY > 3 then ActiveBall.VelY = 5 - End Sub - - ' Targets - Sub sw6_Hit :vpmTimer.PulseSw 14:STHit 6: End Sub - Sub sw7_Hit :vpmTimer.PulseSw 15:STHit 7: End Sub - Sub sw8_Hit :vpmTimer.PulseSw 16:STHit 8: End Sub - Sub sw9_Hit :vpmTimer.PulseSw 17:STHit 9: End Sub - Sub sw11_Hit :vpmTimer.PulseSw 20:STHit 11: End Sub - Sub sw17_Hit :vpmTimer.PulseSw 22:STHit 17: End Sub - Sub sw18_Hit :vpmTimer.PulseSw 23:STHit 18: End Sub - Sub sw25_Hit :vpmTimer.PulseSw 25:STHit 25: End Sub - Sub sw20_Hit :vpmTimer.PulseSw 30:STHit 20: End Sub - Sub sw21_Hit :vpmTimer.PulseSw 31:STHit 21: End Sub - Sub sw22_Hit :vpmTimer.PulseSw 32:STHit 22: End Sub - Sub sw23_Hit :vpmTimer.PulseSw 33:STHit 23: End Sub - - - ' Gates - Sub Gate2_Hit : vpmTimer.PulseSw 5 : End Sub - - 'Spinners - Sub Spinner3_Spin : vpmTimer.PulseSw 7 : SoundSpinner Spinner3 : End Sub - - - ' Gate-Diverter - Dim DivOn, Gatediv - - Sub DivHelp_Hit() : GatePrim.Enabled = 1: Gatediv = 1: GatePri.Collidable = False: End Sub - - - Sub GatePrim_Timer - Select Case Gatediv - Case 1:GatePri.RotZ = 65 - Case 2:GatePri.RotZ = 70 - Case 3:GatePri.RotZ = 75 - Case 4:GatePri.RotZ = 80 - Case 5:GatePri.RotZ = 85: - Case 6:vpmtimer.addtimer 400,"GatePri.RotZ = 60:GatePri.Collidable = True'": GatePrim.Enabled = 0 - End Select - Gatediv = Gatediv + 1 - End Sub - - -Sub GateL_Hit() - GateLong.RotZ = -45 - GStep = 0 - GateL.TimerEnabled = 1 -End Sub - -Sub GateL_Timer - Select Case GStep - Case 1:GateLong.RotZ = 0 - Case 2:GateLong.RotZ = -30 - Case 3:GateLong.RotZ = -70:GateL.TimerEnabled = 0 - End Select - GStep = GStep + 1 -End Sub - - -Sub swPlunger_Hit: BIPL=1 :End Sub -Sub swPlunger_UnHit: BIPL=0 :End Sub - - -'******************************************* -' Ramp Triggers -'******************************************* - -Sub ramptrigger01_hit() - WireRampOn False 'Play Wire Ramp Sound -End Sub - -Sub ramptrigger02_hit() - WireRampOff ' Turn off the Plastic Ramp Sound -End Sub - -Sub ramptrigger03_hit() - WireRampOn False 'Play Wire Ramp Sound -End Sub - -Sub ramptrigger04_hit() - WireRampOff ' Turn off the Plastic Ramp Sound -End Sub - - -'******************************************* -' Knocker Solenoid -'******************************************* - -Sub SolKnocker(Enabled) - If enabled Then - KnockerSolenoid - End If -End Sub - - '************************************ -' LEDs Display -' Based on Scapino's LEDs -'************************************ - -Dim Digits(33) -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) = f0 -Set Digits(31) = f1 -Set Digits(32) = f2 - - -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 - - '************* - ' Update Lamps - '************* - - 'Sonic Pole Position - 'added by Inkochnito - Sub editDips - Dim vpmDips : Set vpmDips = New cvpmDips - With vpmDips - .AddForm 700, 280, "Pole Position - DIP switches" - .AddFrame 205, 0, 190, "Coins per game", &H00000018, Array("1-5-2", 0, "1-6-3", &H00000008, "2-8-4", &H00000010, "(2x)1-3-1", &H00000018) 'dip 12&13 (4&5) - .AddFrame 205, 75, 190, "Score threshold", &H00000003, Array("3,900,000 points", &H00000003, "3,500,000 points", &H00000002, "3,200,000 points", &H00000001, "3,000,000 points", 0) 'dip 16&15 (1&2) - .AddFrame 0, 75, 190, "Balls per game", &H00000004, Array("3 balls", 0, "5 balls", &H00000004) 'dip 14 (3) - .AddFrame 0, 0, 190, "Bonus multiplier", &H00000300, Array("3X", &H00000400, "3X && 6X", &H00000200, "3X && 6X && 9X", &H00000100, "3X && 6X && 9X && 12X", 0) 'dip 7&8 (10&9) - .AddChk 0, 125, 150, Array("Match feature off", &H00000040) 'dip 10 (7) - .AddChk 0, 140, 150, Array("Attract mode off", &H00000020) 'dip 11 (6) - .AddChk 0, 155, 150, Array("Test", 32768) 'dip 1 (16) - .AddChk 0, 170, 150, Array("Erase memory", &H00002000) 'dip 3 (14) - '.AddChk 0,155,150,Array("NU",&H00001000)'dip 4 (13) - '.AddChk 0,115,150,Array("NU",&H00000400)'dip 6 (11) - '.AddChk 0,150,150,Array("NU",&H00000080)'dip 9 (8) - '.AddChk 0,195,150,Array("NU",&H00000800)'dip 5 (12) - '.AddChk 0,125,150,Array("NU",&H00004000)'dip 2 (15) - .AddLabel 0, 300, 280, 20, "After hitting OK, press F3 to reset game with new settings." - .ViewDips - End With - End Sub - - 'Set LampCallback = GetRef("UpdateLamps") - Set vpmShowDips = GetRef("editDips") - - - -'*************************************************************** -'**** VPW DYNAMIC BALL SHADOWS by Iakki, Apophis, and Wylte -'*************************************************************** - -'****** INSTRUCTIONS please read ****** - -'****** Part A: Table Elements ****** -' -' Import the "bsrtx7" and "ballshadow" images -' Import the shadow materials file (3 sets included) (you can also export the 3 sets from this table to create the same file) -' Copy in the BallShadowA flasher set and the sets of primitives named BallShadow#, RtxBallShadow#, and RtxBall2Shadow# -' * Count from 0 up, with at least as many objects each as there can be balls, including locked balls. You'll get an "eval" warning if tnob is higher -' * Warning: If merging with another system (JP's ballrolling), you may need to check tnob math and add an extra BallShadowA# flasher (out of range error) -' Ensure you have a timer with a -1 interval that is always running -' Set plastic ramps DB to *less* than the ambient shadows (-10000) if you want to see the pf shadow through the ramp - -' Create a collection called DynamicSources that includes all light sources you want to cast ball shadows -' It's recommended that you be selective in which lights go in this collection, as there are limitations: -' 1. The shadows can "pass through" solid objects and other light sources, so be mindful of where the lights would actually able to cast shadows -' 2. If there are more than two equidistant sources, the shadows can suddenly switch on and off, so places like top and bottom lanes need attention -' 3. At this time the shadows get the light on/off from tracking gilvl, so if you have lights you want shadows for that are on at different times you will need to either: -' a) remove this restriction (shadows think lights are always On) -' b) come up with a custom solution (see TZ example in script) -' After confirming the shadows work in general, use ball control to move around and look for any weird behavior - -'****** End Part A: Table Elements ****** - - -'****** Part B: Code and Functions ****** - -' *** Timer sub -' The "DynamicBSUpdate" sub should be called by a timer with an interval of -1 (framerate) -' Example timer sub: - -'Sub FrameTimer_Timer() -' If DynamicBallShadowsOn Or AmbientBallShadowOn Then DynamicBSUpdate 'update ball shadows -'End Sub - -' *** These are usually defined elsewhere (ballrolling), but activate here if necessary -'Const tnob = 10 ' total number of balls -'Const lob = 0 'locked balls on start; might need some fiddling depending on how your locked balls are done -'Dim tablewidth: tablewidth = Table1.width -'Dim tableheight: tableheight = Table1.height - -' *** User Options - Uncomment here or move to top for easy access by players -'----- Shadow Options ----- -'Const DynamicBallShadowsOn = 1 '0 = no dynamic ball shadow ("triangles" near slings and such), 1 = enable dynamic ball shadow -'Const AmbientBallShadowOn = 1 '0 = Static shadow under ball ("flasher" image, like JP's) -' '1 = Moving ball shadow ("primitive" object, like ninuzzu's) - This is the only one that shows up on the pf when in ramps and fades when close to lights! -' '2 = flasher image shadow, but it moves like ninuzzu's - -' *** This segment goes within the RollingUpdate sub, so that if Ambient...=0 and Dynamic...=0 the entire DynamicBSUpdate sub can be skipped for max performance -' *** Change BOT to BOT if using existing getballs code -' *** Includes lines commonly found there, for reference: -' ' stop the sound of deleted balls -' For b = UBound(BOT) + 1 to tnob -' If AmbientBallShadowOn = 0 Then BallShadowA(b).visible = 0 -' ...rolling(b) = False -' ...StopSound("BallRoll_" & b) -' Next -' -' ...rolling and drop sounds... - -' If DropCount(b) < 5 Then -' DropCount(b) = DropCount(b) + 1 -' End If -' -' ' "Static" Ball Shadows -' If AmbientBallShadowOn = 0 Then -' If BOT(b).Z > 30 Then -' BallShadowA(b).height=BOT(b).z - BallSize/4 'This is technically 1/4 of the ball "above" the ramp, but it keeps it from clipping the ramp -' Else -' BallShadowA(b).height=BOT(b).z - BallSize/2 + 5 -' End If -' BallShadowA(b).Y = BOT(b).Y + Ballsize/5 + offsetY -' BallShadowA(b).X = BOT(b).X + offsetX -' BallShadowA(b).visible = 1 -' End If - -' *** Required Functions, enable these if they are not already present elswhere in your table -Function max(a,b) - if a > b then - max = a - Else - max = b - end if -end Function - -'Function Distance(ax,ay,bx,by) -' Distance = SQR((ax - bx)^2 + (ay - by)^2) -'End Function - -'Dim PI: PI = 4*Atn(1) - -'Function Atn2(dy, dx) -' 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 - -'Function AnglePP(ax,ay,bx,by) -' AnglePP = Atn2((by - ay),(bx - ax))*180/PI -'End Function - -'****** End Part B: Code and Functions ****** - - -'****** Part C: The Magic ****** - -' *** These define the appearance of shadows in your table *** - -'Ambient (Room light source) -Const AmbientBSFactor = 0.9 '0 to 1, higher is darker -Const AmbientMovement = 2 '1 to 4, higher means more movement as the ball moves left and right -Const offsetX = 0 'Offset x position under ball (These are if you want to change where the "room" light is for calculating the shadow position,) -Const offsetY = 0 'Offset y position under ball (for example 5,5 if the light is in the back left corner) -'Dynamic (Table light sources) -Const DynamicBSFactor = 0.95 '0 to 1, higher is darker -Const Wideness = 20 'Sets how wide the dynamic ball shadows can get (20 +5 thinness is technically most accurate for lights at z ~25 hitting a 50 unit ball) -Const Thinness = 5 'Sets minimum as ball moves away from source - -' *** *** - -' *** Trim or extend these to *match* the number of balls/primitives/flashers on the table! -dim objrtx1(5), objrtx2(5) -dim objBallShadow(5) -Dim BallShadowA -BallShadowA = Array (BallShadowA0,BallShadowA1,BallShadowA2,BallShadowA3,BallShadowA4) -Dim DSSources(30), numberofsources', DSGISide(30) 'Adapted for TZ with GI left / GI right - -'Initialization -DynamicBSInit - -sub DynamicBSInit() - Dim iii, source - - for iii = 0 to tnob - 1 'Prepares the shadow objects before play begins - Set objrtx1(iii) = Eval("RtxBallShadow" & iii) - objrtx1(iii).material = "RtxBallShadow" & iii - objrtx1(iii).z = 1 + iii/1000 + 0.01 'Separate z for layering without clipping - objrtx1(iii).visible = 0 - - Set objrtx2(iii) = Eval("RtxBall2Shadow" & iii) - objrtx2(iii).material = "RtxBallShadow2_" & iii - objrtx2(iii).z = 1 + iii/1000 + 0.02 - objrtx2(iii).visible = 0 - - Set objBallShadow(iii) = Eval("BallShadow" & iii) - objBallShadow(iii).material = "BallShadow" & iii - UpdateMaterial objBallShadow(iii).material,1,0,0,0,0,0,AmbientBSFactor,RGB(0,0,0),0,0,False,True,0,0,0,0 - objBallShadow(iii).Z = 1 + iii/1000 + 0.04 - objBallShadow(iii).visible = 0 - - BallShadowA(iii).Opacity = 100*AmbientBSFactor - BallShadowA(iii).visible = 0 - Next - - iii = 0 - - For Each Source in DynamicSources - DSSources(iii) = Array(Source.x, Source.y) -' If Instr(Source.name , "Left") > 0 Then DSGISide(iii) = 0 Else DSGISide(iii) = 1 'Adapted for TZ with GI left / GI right - iii = iii + 1 - Next - numberofsources = iii -end sub - -Sub DynamicBSUpdate - Dim falloff: falloff = 150 'Max distance to light sources, can be changed dynamically if you have a reason - Dim ShadowOpacity1, ShadowOpacity2 - Dim s, LSd, iii - Dim dist1, dist2, src1, src2 - Dim BOT: BOT=getballs 'Uncomment if you're deleting balls - Don't do it! #SaveTheBalls - - 'Hide shadow of deleted balls - For s = UBound(BOT) + 1 to tnob - 1 - objrtx1(s).visible = 0 - objrtx2(s).visible = 0 - objBallShadow(s).visible = 0 - BallShadowA(s).visible = 0 - Next - - If UBound(BOT) < lob Then Exit Sub 'No balls in play, exit - -'The Magic happens now - For s = lob to UBound(BOT) - -' *** Normal "ambient light" ball shadow - 'Layered from top to bottom. If you had an upper pf at for example 80 units and ramps even above that, your segments would be z>110; z<=110 And z>100; z<=100 And z>30; z<=30 And z>20; Else invisible - - If AmbientBallShadowOn = 1 Then 'Primitive shadow on playfield, flasher shadow in ramps - If BOT(s).Z > 30 Then 'The flasher follows the ball up ramps while the primitive is on the pf - If BOT(s).X < tablewidth/2 Then - objBallShadow(s).X = ((BOT(s).X) - (Ballsize/10) + ((BOT(s).X - (tablewidth/2))/(Ballsize/AmbientMovement))) + offsetX + 5 - Else - objBallShadow(s).X = ((BOT(s).X) + (Ballsize/10) + ((BOT(s).X - (tablewidth/2))/(Ballsize/AmbientMovement))) + offsetX - 5 - End If - objBallShadow(s).Y = BOT(s).Y + BallSize/10 + offsetY - objBallShadow(s).visible = 1 - - BallShadowA(s).X = BOT(s).X + offsetX - BallShadowA(s).Y = BOT(s).Y + BallSize/5 - BallShadowA(s).height=BOT(s).z - BallSize/4 'This is technically 1/4 of the ball "above" the ramp, but it keeps it from clipping the ramp - BallShadowA(s).visible = 1 - Elseif BOT(s).Z <= 30 And BOT(s).Z > 20 Then 'On pf, primitive only - objBallShadow(s).visible = 1 - If BOT(s).X < tablewidth/2 Then - objBallShadow(s).X = ((BOT(s).X) - (Ballsize/10) + ((BOT(s).X - (tablewidth/2))/(Ballsize/AmbientMovement))) + offsetX + 5 - Else - objBallShadow(s).X = ((BOT(s).X) + (Ballsize/10) + ((BOT(s).X - (tablewidth/2))/(Ballsize/AmbientMovement))) + offsetX - 5 - End If - objBallShadow(s).Y = BOT(s).Y + offsetY -' objBallShadow(s).Z = BOT(s).Z + s/1000 + 0.04 'Uncomment (and adjust If/Elseif height logic) if you want the primitive shadow on an upper/split pf - BallShadowA(s).visible = 0 - Else 'Under pf, no shadows - objBallShadow(s).visible = 0 - BallShadowA(s).visible = 0 - end if - - Elseif AmbientBallShadowOn = 2 Then 'Flasher shadow everywhere - If BOT(s).Z > 30 Then 'In a ramp - BallShadowA(s).X = BOT(s).X + offsetX - BallShadowA(s).Y = BOT(s).Y + BallSize/5 - BallShadowA(s).height=BOT(s).z - BallSize/4 'This is technically 1/4 of the ball "above" the ramp, but it keeps it from clipping the ramp - BallShadowA(s).visible = 1 - Elseif BOT(s).Z <= 30 And BOT(s).Z > 20 Then 'On pf - BallShadowA(s).visible = 1 - If BOT(s).X < tablewidth/2 Then - BallShadowA(s).X = ((BOT(s).X) - (Ballsize/10) + ((BOT(s).X - (tablewidth/2))/(Ballsize/AmbientMovement))) + offsetX + 5 - Else - BallShadowA(s).X = ((BOT(s).X) + (Ballsize/10) + ((BOT(s).X - (tablewidth/2))/(Ballsize/AmbientMovement))) + offsetX - 5 - End If - BallShadowA(s).Y = BOT(s).Y + Ballsize/10 + offsetY - BallShadowA(s).height=BOT(s).z - BallSize/2 + 5 - Else 'Under pf - BallShadowA(s).visible = 0 - End If - End If - -' *** Dynamic shadows - If DynamicBallShadowsOn Then - If BOT(s).Z < 30 And BOT(s).X < 850 Then 'Parameters for where the shadows can show, here they are not visible above the table (no upper pf) or in the plunger lane - dist1 = falloff: - dist2 = falloff - For iii = 0 to numberofsources - 1 ' Search the 2 nearest influencing lights - LSd = Distance(BOT(s).x, BOT(s).y, DSSources(iii)(0), DSSources(iii)(1)) 'Calculating the Linear distance to the Source - If LSd < falloff And gilvl > 0 Then -' If LSd < dist2 And ((DSGISide(iii) = 0 And Lampz.State(100)>0) Or (DSGISide(iii) = 1 And Lampz.State(104)>0)) Then 'Adapted for TZ with GI left / GI right - dist2 = dist1 - dist1 = LSd - src2 = src1 - src1 = iii - End If - Next - ShadowOpacity1 = 0 - If dist1 < falloff Then - objrtx1(s).visible = 1 : objrtx1(s).X = BOT(s).X : objrtx1(s).Y = BOT(s).Y - 'objrtx1(s).Z = BOT(s).Z - 25 + s/1000 + 0.01 'Uncomment if you want to add shadows to an upper/lower pf - objrtx1(s).rotz = AnglePP(DSSources(src1)(0), DSSources(src1)(1), BOT(s).X, BOT(s).Y) + 90 - ShadowOpacity1 = 1 - dist1 / falloff - objrtx1(s).size_y = Wideness * ShadowOpacity1 + Thinness - UpdateMaterial objrtx1(s).material,1,0,0,0,0,0,ShadowOpacity1*DynamicBSFactor^3,RGB(0,0,0),0,0,False,True,0,0,0,0 - Else - objrtx1(s).visible = 0 - End If - ShadowOpacity2 = 0 - If dist2 < falloff Then - objrtx2(s).visible = 1 : objrtx2(s).X = BOT(s).X : objrtx2(s).Y = BOT(s).Y + offsetY - 'objrtx2(s).Z = BOT(s).Z - 25 + s/1000 + 0.02 'Uncomment if you want to add shadows to an upper/lower pf - objrtx2(s).rotz = AnglePP(DSSources(src2)(0), DSSources(src2)(1), BOT(s).X, BOT(s).Y) + 90 - ShadowOpacity2 = 1 - dist2 / falloff - objrtx2(s).size_y = Wideness * ShadowOpacity2 + Thinness - UpdateMaterial objrtx2(s).material,1,0,0,0,0,0,ShadowOpacity2*DynamicBSFactor^3,RGB(0,0,0),0,0,False,True,0,0,0,0 - Else - objrtx2(s).visible = 0 - End If - If AmbientBallShadowOn = 1 Then - 'Fades the ambient shadow (primitive only) when it's close to a light - UpdateMaterial objBallShadow(s).material,1,0,0,0,0,0,AmbientBSFactor*(1 - max(ShadowOpacity1, ShadowOpacity2)),RGB(0,0,0),0,0,False,True,0,0,0,0 - Else - BallShadowA(s).Opacity = 100 * AmbientBSFactor * (1 - max(ShadowOpacity1, ShadowOpacity2)) - End If - Else 'Hide dynamic shadows everywhere else, just in case - objrtx2(s).visible = 0 : objrtx1(s).visible = 0 - End If - End If - Next -End Sub -'**************************************************************** -'**** END VPW DYNAMIC BALL SHADOWS by Iakki, Apophis, and Wylte -'**************************************************************** - -'****************************************************** -' VPW TargetBouncer for targets and posts by Iaakki, Wrd1972, Apophis -'****************************************************** - -Const TargetBouncerEnabled = 1 '0 = normal standup targets, 1 = bouncy targets -Const TargetBouncerFactor = 0.7 'Level of bounces. Recommmended value of 0.7 - -sub TargetBouncer(aBall,defvalue) - dim zMultiplier, vel, vratio - if TargetBouncerEnabled = 1 and aball.z < 30 then - 'debug.print "velx: " & aball.velx & " vely: " & aball.vely & " velz: " & aball.velz - vel = BallSpeed(aBall) - if aBall.velx = 0 then vratio = 1 else vratio = aBall.vely/aBall.velx - Select Case Int(Rnd * 6) + 1 - Case 1: zMultiplier = 0.2*defvalue - Case 2: zMultiplier = 0.25*defvalue - Case 3: zMultiplier = 0.3*defvalue - Case 4: zMultiplier = 0.4*defvalue - Case 5: zMultiplier = 0.45*defvalue - Case 6: zMultiplier = 0.5*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 - -' Add targets or posts to the TargetBounce collection if you want to activate the targetbouncer code from them -Sub TargetBounce_Hit(idx) - TargetBouncer activeball, 1 -End Sub - - - - -'****************************************************** -'**** FLIPPER CORRECTIONS by nFozzy -'****************************************************** -' -' There are several steps for taking advantage of nFozzy's flipper solution. At a high level we’ll need the following: -' 1. flippers with specific physics settings -' 2. custom triggers for each flipper (TriggerLF, TriggerRF) -' 3. an object or point to tell the script where the tip of the flipper is at rest (EndPointLp, EndPointRp) -' 4. and, special scripting -' -' A common mistake is incorrect flipper length. A 3-inch flipper with rubbers will be about 3.125 inches long. -' This translates to about 147 vp units. Therefore, the flipper start radius + the flipper length + the flipper end -' radius should equal approximately 147 vp units. Another common mistake is is that sometimes the right flipper -' angle was set with a large postive value (like 238 or something). It should be using negative value (like -122). -' -' The following settings are a solid starting point for various eras of pinballs. -' | | EM's | late 70's to mid 80's | mid 80's to early 90's | mid 90's and later | -' | ------------------ | -------------- | --------------------- | ---------------------- | ------------------ | -' | Mass | 1 | 1 | 1 | 1 | -' | Strength | 500-1000 (750) | 1400-1600 (1500) | 2000-2600 | 3200-3300 (3250) | -' | Elasticity | 0.88 | 0.88 | 0.88 | 0.88 | -' | Elasticity Falloff | 0.15 | 0.15 | 0.15 | 0.15 | -' | Fricition | 0.8-0.9 | 0.9 | 0.9 | 0.9 | -' | Return Strength | 0.11 | 0.09 | 0.07 | 0.055 | -' | Coil Ramp Up | 2.5 | 2.5 | 2.5 | 2.5 | -' | Scatter Angle | 0 | 0 | 0 | 0 | -' | EOS Torque | 0.3 | 0.3 | 0.275 | 0.275 | -' | EOS Torque Angle | 4 | 4 | 6 | 6 | -' - - -'****************************************************** -' Flippers Polarity (Select appropriate sub based on era) -'****************************************************** - -dim LF : Set LF = New FlipperPolarity -dim RF : Set RF = New FlipperPolarity - -InitPolarity - - - -'******************************************* -' Late 80's early 90'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 = 60 - Next - - AddPt "Polarity", 0, 0, 0 - AddPt "Polarity", 1, 0.05, -5 - AddPt "Polarity", 2, 0.4, -5 - AddPt "Polarity", 3, 0.6, -4.5 - AddPt "Polarity", 4, 0.65, -4.0 - AddPt "Polarity", 5, 0.7, -3.5 - AddPt "Polarity", 6, 0.75, -3.0 - AddPt "Polarity", 7, 0.8, -2.5 - AddPt "Polarity", 8, 0.85, -2.0 - AddPt "Polarity", 9, 0.9,-1.5 - AddPt "Polarity", 10, 0.95, -1.0 - AddPt "Polarity", 11, 1, -0.5 - AddPt "Polarity", 12, 1.1, 0 - AddPt "Polarity", 13, 1.3, 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 - - - -' -''******************************************* -'' Early 90's and after -' -'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 = 60 -' Next -' -' AddPt "Polarity", 0, 0, 0 -' AddPt "Polarity", 1, 0.05, -5.5 -' AddPt "Polarity", 2, 0.4, -5.5 -' AddPt "Polarity", 3, 0.6, -5.0 -' AddPt "Polarity", 4, 0.65, -4.5 -' AddPt "Polarity", 5, 0.7, -4.0 -' AddPt "Polarity", 6, 0.75, -3.5 -' AddPt "Polarity", 7, 0.8, -3.0 -' AddPt "Polarity", 8, 0.85, -2.5 -' AddPt "Polarity", 9, 0.9,-2.0 -' AddPt "Polarity", 10, 0.95, -1.5 -' AddPt "Polarity", 11, 1, -1.0 -' AddPt "Polarity", 12, 1.05, -0.5 -' AddPt "Polarity", 13, 1.1, 0 -' AddPt "Polarity", 14, 1.3, 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 - - -' Flipper trigger hit subs - -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 -'****************************************************** - -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) - End If - End If - RemoveBall aBall - End Sub -End Class - - - - - -'****************************************************** -' SLINGSHOT CORRECTION FUNCTIONS -'****************************************************** -' To add these slingshot corrections: -' - On the table, add the endpoint primitives that define the two ends of the Slingshot -' - Initialize the SlingshotCorrection objects in InitSlingCorrection -' - Call the .VelocityCorrect methods from the respective _Slingshot event sub - - -dim LS : Set LS = New SlingshotCorrection -dim RS : Set RS = New SlingshotCorrection - -InitSlingCorrection - -Sub InitSlingCorrection - - LS.Object = LeftSlingshot - LS.EndPoint1 = EndPoint1LS - LS.EndPoint2 = EndPoint2LS - - RS.Object = RightSlingshot - RS.EndPoint1 = EndPoint1RS - RS.EndPoint2 = EndPoint2RS - - 'Slingshot angle corrections (pt, BallPos in %, Angle in deg) - ' These values are best guesses. Retune them if needed based on specific table research. - AddSlingsPt 0, 0.00, -4 - AddSlingsPt 1, 0.45, -7 - AddSlingsPt 2, 0.48, 0 - AddSlingsPt 3, 0.52, 0 - AddSlingsPt 4, 0.55, 7 - AddSlingsPt 5, 1.00, 4 - -End Sub - - -Sub AddSlingsPt(idx, aX, aY) 'debugger wrapper for adjusting flipper script in-game - dim a : a = Array(LS, RS) - dim x : for each x in a - x.addpoint idx, aX, aY - Next -End Sub - -'' The following sub are needed, however they may exist somewhere else in the script. Uncomment below if needed -'Dim PI: PI = 4*Atn(1) -'Function dSin(degrees) -' dsin = sin(degrees * Pi/180) -'End Function -'Function dCos(degrees) -' dcos = cos(degrees * Pi/180) -'End Function -' -Function RotPoint(x,y,angle) - dim rx, ry - rx = x*dCos(angle) - y*dSin(angle) - ry = x*dSin(angle) + y*dCos(angle) - RotPoint = Array(rx,ry) -End Function - -Class SlingshotCorrection - Public DebugOn, Enabled - private Slingshot, SlingX1, SlingX2, SlingY1, SlingY2 - - Public ModIn, ModOut - Private Sub Class_Initialize : redim ModIn(0) : redim Modout(0): Enabled = True : End Sub - - Public Property let Object(aInput) : Set Slingshot = aInput : End Property - Public Property Let EndPoint1(aInput) : SlingX1 = aInput.x: SlingY1 = aInput.y: End Property - Public Property Let EndPoint2(aInput) : SlingX2 = aInput.x: SlingY2 = aInput.y: End Property - - 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 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 - - - Public Sub VelocityCorrect(aBall) - dim BallPos, XL, XR, YL, YR - - 'Assign right and left end points - If SlingX1 < SlingX2 Then - XL = SlingX1 : YL = SlingY1 : XR = SlingX2 : YR = SlingY2 - Else - XL = SlingX2 : YL = SlingY2 : XR = SlingX1 : YR = SlingY1 - End If - - 'Find BallPos = % on Slingshot - If Not IsEmpty(aBall.id) Then - If ABS(XR-XL) > ABS(YR-YL) Then - BallPos = PSlope(aBall.x, XL, 0, XR, 1) - Else - BallPos = PSlope(aBall.y, YL, 0, YR, 1) - End If - If BallPos < 0 Then BallPos = 0 - If BallPos > 1 Then BallPos = 1 - End If - - 'Velocity angle correction - If not IsEmpty(ModIn(0) ) then - Dim Angle, RotVxVy - Angle = LinearEnvelope(BallPos, ModIn, ModOut) - 'debug.print " BallPos=" & BallPos &" Angle=" & Angle - 'debug.print " BEFORE: aBall.Velx=" & aBall.Velx &" aBall.Vely" & aBall.Vely - RotVxVy = RotPoint(aBall.Velx,aBall.Vely,Angle) - If Enabled then aBall.Velx = RotVxVy(0) - If Enabled then aBall.Vely = RotVxVy(1) - 'debug.print " AFTER: aBall.Velx=" & aBall.Velx &" aBall.Vely" & aBall.Vely - 'debug.print " " - End If - End Sub - -End Class - - - -'****************************************************** -' FLIPPER POLARITY. RUBBER DAMPENER, AND SLINGSHOT CORRECTION SUPPORTING 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 - - -' 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 - - -'****************************************************** -' 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 b', BOT - BOT = GetBalls - - If Flipper1.currentangle = Endangle1 and EOSNudge1 <> 1 Then - EOSNudge1 = 1 - 'debug.print Flipper1.currentangle &" = "& Endangle1 &"--"& Flipper2.currentangle &" = "& EndAngle2 - If Flipper2.currentangle = EndAngle2 Then - 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 - BOT(b).velx = BOT(b).velx / 1.3 - BOT(b).vely = BOT(b).vely - 0.5 - end If - Next - End If - Else - If Abs(Flipper1.currentangle) > Abs(EndAngle1) + 30 then EOSNudge1 = 0 - End If -End Sub - -'***************** -' Maths -'***************** -Dim PI: PI = 4*Atn(1) - -Function dSin(degrees) - dsin = sin(degrees * Pi/180) -End Function - -Function dCos(degrees) - dcos = cos(degrees * Pi/180) -End Function - -Function Atn2(dy, dx) - 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 - -'************************************************* -' 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 - -Const FlipperCoilRampupMode = 0 '0 = fast, 1 = medium, 2 = slow (tap passes should work) - -LFState = 1 -RFState = 1 -EOST = leftflipper.eostorque -EOSA = leftflipper.eostorqueangle -Frampup = LeftFlipper.rampup -FElasticity = LeftFlipper.elasticity -FReturn = LeftFlipper.return -'Const EOSTnew = 1 'EM's to late 80's -Const EOSTnew = 0.8 '90's and later -Const EOSAnew = 1 -Const EOSRampup = 0 -Dim SOSRampup -Select Case FlipperCoilRampupMode - Case 0: - SOSRampup = 2.5 - Case 1: - SOSRampup = 6 - Case 2: - SOSRampup = 8.5 -End Select - -Const LiveCatch = 16 -Const LiveElasticity = 0.45 -Const SOSEM = 0.815 -'Const EOSReturn = 0.055 'EM's -'Const EOSReturn = 0.045 'late 70's to mid 80's -Const EOSReturn = 0.035 'mid 80's to early 90's -'Const EOSReturn = 0.025 'mid 90's and later - -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 b', BOT -' 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 = 114 '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.5 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 - - If LiveCatchBounce = 0 and ball.velx * Dir > 0 Then ball.velx = 0 - ball.vely = LiveCatchBounce * (32 / LiveCatch) ' Multiplier for inaccuracy bounce - ball.angmomx= 0 - ball.angmomy= 0 - ball.angmomz= 0 - Else - If Abs(Flipper.currentangle) <= Abs(Flipper.endangle) + 1 Then FlippersD.Dampenf Activeball, parm - End If -End Sub - - -'****************************************************** -'**** END FLIPPER CORRECTIONS -'****************************************************** - - - - - - - - -'****************************************************** -'**** 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, 1.1 'point# (keep sequential), ballspeed, CoR (elasticity) -RubbersD.addpoint 1, 3.77, 0.97 -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 - -'######################### Add new FlippersD Profile -'######################### Adjust these values to increase or lessen the elasticity - -dim FlippersD : Set FlippersD = new Dampener -FlippersD.name = "Flippers" -FlippersD.debugOn = False -FlippersD.Print = False -FlippersD.addpoint 0, 0, 1.1 -FlippersD.addpoint 1, 3.77, 0.99 -FlippersD.addpoint 2, 6, 0.99 - -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)+0.0001) - 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 Dampenf(aBall, parm) 'Rubberizer is handle here - dim RealCOR, DesiredCOR, str, coef - DesiredCor = LinearEnvelope(cor.ballvel(aBall.id), ModIn, ModOut ) - RealCOR = BallSpeed(aBall) / (cor.ballvel(aBall.id)+0.0001) - coef = desiredcor / realcor - If abs(aball.velx) < 2 and aball.vely < 0 and aball.vely > -3.75 then - aBall.velx = aBall.velx * coef : aBall.vely = aBall.vely * coef - End If - 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 - - - - -'****************************************************** -'**** END PHYSICS DAMPENERS -'****************************************************** - - - -'****************************************************** -' STAND-UP TARGET INITIALIZATION -'****************************************************** - -Class StandupTarget - Private m_primary, m_prim, m_sw, m_animate - - Public Property Get Primary(): Set Primary = m_primary: End Property - Public Property Let Primary(input): Set m_primary = input: End Property - - Public Property Get Prim(): Set Prim = m_prim: End Property - Public Property Let Prim(input): Set m_prim = input: End Property - - Public Property Get Sw(): Sw = m_sw: End Property - Public Property Let Sw(input): m_sw = input: End Property - - Public Property Get Animate(): Animate = m_animate: End Property - Public Property Let Animate(input): m_animate = input: End Property - - Public default Function init(primary, prim, sw, animate) - Set m_primary = primary - Set m_prim = prim - m_sw = sw - m_animate = animate - - Set Init = Me - End Function -End Class - -'Define a variable for each stand-up target -Dim ST20, ST21, ST22, ST23, ST6, ST7, ST8, ST9, ST11 ,ST17 ,ST18, ST25 - -'Set array with stand-up target objects -' -'StandupTargetvar = Array(primary, prim, swtich) -' primary: vp target to determine target hit -' prim: primitive target used for visuals and animation -' IMPORTANT!!! -' transy must be used to offset the target animation -' switch: ROM switch number -' animate: Arrary slot for handling the animation instrucitons, set to 0 -' -'You will also need to add a secondary hit object for each stand up (name sw11o, sw12o, and sw13o on the example Table1) -'these are inclined primitives to simulate hitting a bent target and should provide so z velocity on high speed impacts - -Set ST20 = (new StandupTarget)(sw20, psw20,20, 0) -Set ST21 = (new StandupTarget)(sw21, psw21,21, 0) -Set ST22 = (new StandupTarget)(sw22, psw22,22, 0) -Set ST23 = (new StandupTarget)(sw23, psw23,23, 0) -Set ST6 = (new StandupTarget)(sw6, psw6,6, 0) -Set ST7 = (new StandupTarget)(sw7, psw7,7, 0) -Set ST8 = (new StandupTarget)(sw8, psw8,8, 0) -Set ST9 = (new StandupTarget)(sw9, psw9,9, 0) -Set ST11 = (new StandupTarget)(sw11, psw11,11, 0) -Set ST17 = (new StandupTarget)(sw17, psw17,17, 0) -Set ST18 = (new StandupTarget)(sw18, psw18,18, 0) -Set ST25 = (new StandupTarget)(sw25, psw25,25, 0) - -'Add all the Stand-up Target Arrays to Stand-up Target Animation Array -' STAnimationArray = Array(ST1, ST2, ....) -Dim STArray -STArray = Array(ST20, ST21, ST22, ST23, ST6, ST7, ST8, ST9, ST11, ST17 ,ST18, ST25) - -'Configure the behavior of Stand-up Targets -Const STAnimStep = 1.5 'vpunits per animation step (control return to Start) -Const STMaxOffset = 9 'max vp units target moves when hit - -Const STMass = 0.2 'Mass of the Stand-up Target (between 0 and 1), higher values provide more resistance - - - -'****************************************************** -' STAND-UP TARGETS FUNCTIONS -'****************************************************** - -Sub STHit(switch) - Dim i - i = STArrayID(switch) - - PlayTargetSound - STArray(i).animate = STCheckHit(Activeball,STArray(i).primary) - - If STArray(i).animate <> 0 Then - DTBallPhysics Activeball, STArray(i).primary.orientation, STMass - End If - DoSTAnim -End Sub - -Function STArrayID(switch) - Dim i - For i = 0 to uBound(STArray) - If STArray(i).sw = switch Then STArrayID = i:Exit Function - Next -End Function - -'Check if target is hit on it's face -Function STCheckHit(aBall, target) - dim bangle, bangleafter, rangle, rangle2, perpvel, perpvelafter, paravel, paravelafter - rangle = (target.orientation - 90) * 3.1416 / 180 - bangle = atn2(cor.ballvely(aball.id),cor.ballvelx(aball.id)) - bangleafter = Atn2(aBall.vely,aball.velx) - - perpvel = cor.BallVel(aball.id) * cos(bangle-rangle) - paravel = cor.BallVel(aball.id) * sin(bangle-rangle) - - perpvelafter = BallSpeed(aBall) * cos(bangleafter - rangle) - paravelafter = BallSpeed(aBall) * sin(bangleafter - rangle) - - If perpvel > 0 and perpvelafter <= 0 Then - STCheckHit = 1 - ElseIf perpvel > 0 and ((paravel > 0 and paravelafter > 0) or (paravel < 0 and paravelafter < 0)) Then - STCheckHit = 1 - Else - STCheckHit = 0 - End If -End Function - -Sub DoSTAnim() - Dim i - For i=0 to Ubound(STArray) - STArray(i).animate = STAnimate(STArray(i).primary,STArray(i).prim,STArray(i).sw,STArray(i).animate) - Next -End Sub - -Function STAnimate(primary, prim, switch, animate) - Dim animtime - - STAnimate = animate - - if animate = 0 Then - primary.uservalue = 0 - STAnimate = 0 - Exit Function - Elseif primary.uservalue = 0 then - primary.uservalue = gametime - end if - - animtime = gametime - primary.uservalue - - If animate = 1 Then - primary.collidable = 0 - prim.transy = -STMaxOffset - if UsingROM then - vpmTimer.PulseSw switch - else - STAction switch - end if - STAnimate = 2 - Exit Function - elseif animate = 2 Then - prim.transy = prim.transy + STAnimStep - If prim.transy >= 0 Then - prim.transy = 0 - primary.collidable = 1 - STAnimate = 0 - Exit Function - Else - STAnimate = 2 - End If - End If -End Function - -Sub STAction(Switch) - Select Case Switch - Case 11: - Addscore 1000 - Flash1 True 'Demo of the flasher - vpmTimer.AddTimer 150,"Flash1 False'" 'Disable the flash after short time, just like a ROM would do - Case 12: - Addscore 1000 - Flash2 True 'Demo of the flasher - vpmTimer.AddTimer 150,"Flash2 False'" 'Disable the flash after short time, just like a ROM would do - Case 13: - Addscore 1000 - Flash3 True 'Demo of the flasher - vpmTimer.AddTimer 150,"Flash3 False'" 'Disable the flash after short time, just like a ROM would do - End Select -End Sub - - - -sub DTBallPhysics(aBall, angle, mass) - dim rangle,bangle,calc1, calc2, calc3 - rangle = (angle - 90) * 3.1416 / 180 - bangle = atn2(cor.ballvely(aball.id),cor.ballvelx(aball.id)) - - calc1 = cor.BallVel(aball.id) * cos(bangle - rangle) * (aball.mass - mass) / (aball.mass + mass) - calc2 = cor.BallVel(aball.id) * sin(bangle - rangle) * cos(rangle + 4*Atn(1)/2) - calc3 = cor.BallVel(aball.id) * sin(bangle - rangle) * sin(rangle + 4*Atn(1)/2) - - aBall.velx = calc1 * cos(rangle) + calc2 - aBall.vely = calc1 * sin(rangle) + calc3 -End Sub - - - - -'****************************************************** -' END STAND-UP TARGETS -'****************************************************** - - - - - -'****************************************************** -'**** BALL ROLLING AND DROP SOUNDS -'****************************************************** -' -' Be sure to call RollingUpdate in a timer with a 10ms interval see the GameTimer_Timer() sub - -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 RollingUpdate() - Dim b', BOT - BOT = GetBalls - - ' stop the sound of deleted balls - For b = UBound(BOT) + 1 to tnob - ' Comment the next line if you are not implementing Dyanmic Ball Shadows - If AmbientBallShadowOn = 0 Then BallShadowA(b).visible = 0 - 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)) * BallRollVolume * 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 - - ' "Static" Ball Shadows - ' Comment the next If block, if you are not implementing the Dyanmic Ball Shadows - If AmbientBallShadowOn = 0 Then - If BOT(b).Z > 30 Then - BallShadowA(b).height=BOT(b).z - BallSize/4 'This is technically 1/4 of the ball "above" the ramp, but it keeps it from clipping the ramp - Else - BallShadowA(b).height=BOT(b).z - BallSize/2 + 5 - End If - BallShadowA(b).Y = BOT(b).Y + Ballsize/5 + offsetY - BallShadowA(b).X = BOT(b).X + offsetX - BallShadowA(b).visible = 1 - End If - Next -End Sub - - -'****************************************************** -'**** END BALL ROLLING AND DROP SOUNDS -'****************************************************** - - - - -'****************************************************** -'**** RAMP ROLLING SFX -'****************************************************** - -'Ball tracking ramp SFX 1.0 -' Reqirements: -' * Import A Sound File for each ball on the table for plastic ramps. Call It RampLoop ex: RampLoop1, RampLoop2, ... -' * Import a Sound File for each ball on the table for wire ramps. Call it WireLoop ex: WireLoop1, WireLoop2, ... -' * Create a Timer called RampRoll, that is enabled, with a interval of 100 -' * Set RampBAlls and RampType variable to Total Number of Balls -' Usage: -' * Setup hit events and call WireRampOn True or WireRampOn False (True = Plastic ramp, False = Wire Ramp) -' * To stop tracking ball -' * call WireRampOff -' * Otherwise, the ball will auto remove if it's below 30 vp units -' - -dim RampMinLoops : RampMinLoops = 4 - -' RampBalls -' Setup: Set the array length of x in RampBalls(x,2) Total Number of Balls on table + 1: if tnob = 5, then RammBalls(6,2) -' Description: -dim RampBalls(6,2) -'x,0 = ball x,1 = ID, 2 = Protection against ending early (minimum amount of updates) -'0,0 is boolean on/off, 0,1 unused for now -RampBalls(0,0) = False - -' RampType -' Setup: Set this array to the number Total number of balls that can be tracked at one time + 1. 5 ball multiball then set value to 6 -' Description: Array type indexed on BallId and a values used to deterimine what type of ramp the ball is on: False = Wire Ramp, True = Plastic Ramp -dim RampType(6) - -Sub WireRampOn(input) : Waddball ActiveBall, input : RampRollUpdate: End Sub -Sub WireRampOff() : WRemoveBall ActiveBall.ID : End Sub - - -' WaddBall (Active Ball, Boolean) -' Description: This subroutine is called from WireRampOn to Add Balls to the RampBalls Array -Sub Waddball(input, RampInput) 'Add ball - ' This will loop through the RampBalls array checking each element of the array x, position 1 - ' To see if the the ball was already added to the array. - ' If the ball is found then exit the subroutine - dim x : for x = 1 to uBound(RampBalls) 'Check, don't add balls twice - if RampBalls(x, 1) = input.id then - if Not IsEmpty(RampBalls(x,1) ) then Exit Sub 'Frustating issue with BallId 0. Empty variable = 0 - End If - Next - - ' This will itterate through the RampBalls Array. - ' The first time it comes to a element in the array where the Ball Id (Slot 1) is empty. It will add the current ball to the array - ' The RampBalls assigns the ActiveBall to element x,0 and ball id of ActiveBall to 0,1 - ' The RampType(BallId) is set to RampInput - ' RampBalls in 0,0 is set to True, this will enable the timer and the timer is also turned on - For x = 1 to uBound(RampBalls) - if IsEmpty(RampBalls(x, 1)) then - Set RampBalls(x, 0) = input - RampBalls(x, 1) = input.ID - RampType(x) = RampInput - RampBalls(x, 2) = 0 - 'exit For - RampBalls(0,0) = True - RampRoll.Enabled = 1 'Turn on timer - 'RampRoll.Interval = RampRoll.Interval 'reset timer - exit Sub - End If - if x = uBound(RampBalls) then 'debug - Debug.print "WireRampOn error, ball queue is full: " & vbnewline & _ - RampBalls(0, 0) & vbnewline & _ - Typename(RampBalls(1, 0)) & " ID:" & RampBalls(1, 1) & "type:" & RampType(1) & vbnewline & _ - Typename(RampBalls(2, 0)) & " ID:" & RampBalls(2, 1) & "type:" & RampType(2) & vbnewline & _ - Typename(RampBalls(3, 0)) & " ID:" & RampBalls(3, 1) & "type:" & RampType(3) & vbnewline & _ - Typename(RampBalls(4, 0)) & " ID:" & RampBalls(4, 1) & "type:" & RampType(4) & vbnewline & _ - Typename(RampBalls(5, 0)) & " ID:" & RampBalls(5, 1) & "type:" & RampType(5) & vbnewline & _ - " " - End If - next -End Sub - -' WRemoveBall (BallId) -' Description: This subroutine is called from the RampRollUpdate subroutine -' and is used to remove and stop the ball rolling sounds -Sub WRemoveBall(ID) 'Remove ball - 'Debug.Print "In WRemoveBall() + Remove ball from loop array" - dim ballcount : ballcount = 0 - dim x : for x = 1 to Ubound(RampBalls) - if ID = RampBalls(x, 1) then 'remove ball - Set RampBalls(x, 0) = Nothing - RampBalls(x, 1) = Empty - RampType(x) = Empty - StopSound("RampLoop" & x) - StopSound("wireloop" & x) - end If - 'if RampBalls(x,1) = Not IsEmpty(Rampballs(x,1) then ballcount = ballcount + 1 - if not IsEmpty(Rampballs(x,1)) then ballcount = ballcount + 1 - next - if BallCount = 0 then RampBalls(0,0) = False 'if no balls in queue, disable timer update -End Sub - -Sub RampRoll_Timer():RampRollUpdate:End Sub - -Sub RampRollUpdate() 'Timer update - dim x : for x = 1 to uBound(RampBalls) - if Not IsEmpty(RampBalls(x,1) ) then - if BallVel(RampBalls(x,0) ) > 1 then ' if ball is moving, play rolling sound - If RampType(x) then - PlaySound("RampLoop" & x), -1, VolPlayfieldRoll(RampBalls(x,0)) * RampRollVolume * VolumeDial, AudioPan(RampBalls(x,0)), 0, BallPitchV(RampBalls(x,0)), 1, 0, AudioFade(RampBalls(x,0)) - StopSound("wireloop" & x) - Else - StopSound("RampLoop" & x) - PlaySound("wireloop" & x), -1, VolPlayfieldRoll(RampBalls(x,0)) * RampRollVolume * VolumeDial, AudioPan(RampBalls(x,0)), 0, BallPitch(RampBalls(x,0)), 1, 0, AudioFade(RampBalls(x,0)) - End If - RampBalls(x, 2) = RampBalls(x, 2) + 1 - Else - StopSound("RampLoop" & x) - StopSound("wireloop" & x) - end if - if RampBalls(x,0).Z < 30 and RampBalls(x, 2) > RampMinLoops then 'if ball is on the PF, remove it - StopSound("RampLoop" & x) - StopSound("wireloop" & x) - Wremoveball RampBalls(x,1) - End If - Else - StopSound("RampLoop" & x) - StopSound("wireloop" & x) - end if - next - if not RampBalls(0,0) then RampRoll.enabled = 0 - -End Sub - -' This can be used to debug the Ramp Roll time. You need to enable the tbWR timer on the TextBox -Sub tbWR_Timer() 'debug textbox - me.text = "on? " & RampBalls(0, 0) & " timer: " & RampRoll.Enabled & vbnewline & _ - "1 " & Typename(RampBalls(1, 0)) & " ID:" & RampBalls(1, 1) & " type:" & RampType(1) & " Loops:" & RampBalls(1, 2) & vbnewline & _ - "2 " & Typename(RampBalls(2, 0)) & " ID:" & RampBalls(2, 1) & " type:" & RampType(2) & " Loops:" & RampBalls(2, 2) & vbnewline & _ - "3 " & Typename(RampBalls(3, 0)) & " ID:" & RampBalls(3, 1) & " type:" & RampType(3) & " Loops:" & RampBalls(3, 2) & vbnewline & _ - "4 " & Typename(RampBalls(4, 0)) & " ID:" & RampBalls(4, 1) & " type:" & RampType(4) & " Loops:" & RampBalls(4, 2) & vbnewline & _ - "5 " & Typename(RampBalls(5, 0)) & " ID:" & RampBalls(5, 1) & " type:" & RampType(5) & " Loops:" & RampBalls(5, 2) & vbnewline & _ - "6 " & Typename(RampBalls(6, 0)) & " ID:" & RampBalls(6, 1) & " type:" & RampType(6) & " Loops:" & RampBalls(6, 2) & vbnewline & _ - " " -End Sub - - -Function BallPitch(ball) ' Calculates the pitch of the sound based on the ball speed - BallPitch = pSlope(BallVel(ball), 1, -1000, 60, 10000) -End Function - -Function BallPitchV(ball) ' Calculates the pitch of the sound based on the ball speed Variation - BallPitchV = pSlope(BallVel(ball), 1, -4000, 60, 7000) -End Function - - - -'****************************************************** -'**** END RAMP ROLLING SFX -'****************************************************** - - - - - -'****************************************************** -'**** FLEEP 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 the TOM table - -' Many of the sounds in this package can be added by creating collections and adding the appropriate objects to those collections. -' Create the following new collections: -' Metals (all metal objects, metal walls, metal posts, metal wire guides) -' Apron (the apron walls and plunger wall) -' Walls (all wood or plastic walls) -' Rollovers (wire rollover triggers, star triggers, or button triggers) -' Targets (standup or drop targets, these are hit sounds only ... you will want to add separate dropping sounds for drop targets) -' Gates (plate gates) -' GatesWire (wire gates) -' Rubbers (all rubbers including posts, sleeves, pegs, and bands) -' When creating the collections, make sure "Fire events for this collection" is checked. -' You'll also need to make sure "Has Hit Event" is checked for each object placed in these collections (not necessary for gates and triggers). -' Once the collections and objects are added, the save, close, and restart VPX. -' -' Many places in the script need to be modified to include the correct sound effect subroutine calls. The tutorial videos linked below demonstrate -' how to make these updates. But in summary the following needs to be updated: -' - Nudging, plunger, coin-in, start button sounds will be added to the keydown and keyup subs. -' - Flipper sounds in the flipper solenoid subs. Flipper collision sounds in the flipper collide subs. -' - Bumpers, slingshots, drain, ball release, knocker, spinner, and saucers in their respective subs -' - Ball rolling sounds sub -' -' Tutorial vides by Apophis -' Part 1: https://youtu.be/PbE2kNiam3g -' Part 2: https://youtu.be/B5cm1Y8wQsk -' Part 3: https://youtu.be/eLhWyuYOyGg - - -'/////////////////////////////// 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] -SpinnerSoundLevel = 0.5 '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 -'****************************************************** - -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 > 7000 Then - tmp = 7000 - elseif tmp < -7000 Then - tmp = -7000 - end if - - 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 > 7000 Then - tmp = 7000 - elseif tmp < -7000 Then - tmp = -7000 - end if - - 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, sw1 -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 SoundFX("Bumpers_Middle_" & Int(Rnd*5)+1,DOFContactors), Vol(ActiveBall) * BumperSoundFactor, Bump -End Sub - -Sub RandomSoundBumperBottom(Bump) - PlaySoundAtLevelStatic SoundFX("Bumpers_Bottom_" & Int(Rnd*5)+1,DOFContactors), Vol(ActiveBall) * BumperSoundFactor, Bump -End Sub - -'///////////////////////////// SPINNER SOUNDS //////////////////////////// -Sub SoundSpinner(spinnerswitch) - PlaySoundAtLevelStatic ("Spinner"), SpinnerSoundLevel, spinnerswitch -End Sub - - -'///////////////////////////// FLIPPER BATS SOUND SUBROUTINES //////////////////////////// -'///////////////////////////// FLIPPER BATS SOLENOID ATTACK SOUND //////////////////////////// -Sub SoundFlipperUpAttackLeft(flipper) - FlipperUpAttackLeftSoundLevel = RndNum(FlipperUpAttackMinimumSoundLevel, FlipperUpAttackMaximumSoundLevel) - PlaySoundAtLevelStatic SoundFX("Flipper_Attack-L01",DOFFlippers), FlipperUpAttackLeftSoundLevel, flipper -End Sub - -Sub SoundFlipperUpAttackRight(flipper) - FlipperUpAttackRightSoundLevel = RndNum(FlipperUpAttackMinimumSoundLevel, FlipperUpAttackMaximumSoundLevel) - PlaySoundAtLevelStatic SoundFX("Flipper_Attack-R01",DOFFlippers), 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) - RandomSoundWall() -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 - - -'/////////////////////////// DROP TARGET HIT SOUNDS /////////////////////////// - -Sub RandomSoundDropTargetReset(obj) - PlaySoundAtLevelStatic SoundFX("Drop_Target_Reset_" & Int(Rnd*6)+1,DOFContactors), 1, obj -End Sub - -Sub SoundDropTargetDrop(obj) - PlaySoundAtLevelStatic ("Drop_Target_Down_" & Int(Rnd*6)+1), 200, obj -End Sub - -'///////////////////////////// GI AND FLASHER RELAYS //////////////////////////// - -Const RelayFlashSoundLevel = 0.315 'volume level; range [0, 1]; -Const RelayGISoundLevel = 1.05 'volume level; range [0, 1]; - -Sub Sound_GI_Relay(toggle, obj) - Select Case toggle - Case 1 - PlaySoundAtLevelStatic ("Relay_GI_On"), 0.025*RelayGISoundLevel, obj - Case 0 - PlaySoundAtLevelStatic ("Relay_GI_Off"), 0.025*RelayGISoundLevel, obj - End Select -End Sub - -Sub Sound_Flash_Relay(toggle, obj) - Select Case toggle - Case 1 - PlaySoundAtLevelStatic ("Relay_Flash_On"), 0.025*RelayFlashSoundLevel, obj - Case 0 - PlaySoundAtLevelStatic ("Relay_Flash_Off"), 0.025*RelayFlashSoundLevel, obj - End Select -End Sub - -'///////////////////////////////////////////////////////////////// -' End Mechanical Sounds -'///////////////////////////////////////////////////////////////// - -'****************************************************** -'**** FLEEP MECHANICAL SOUNDS -'****************************************************** - - - - -'****************************************************** -'**** LAMPZ by nFozzy -'****************************************************** -' -' Lampz is a utility designed to manage and fade the lights and light-related objects on a table that is being driven by a ROM. -' To set up Lampz, one must populate the Lampz.MassAssign array with VPX Light objects, where the index of the MassAssign array -' corrisponds to the ROM index of the associated light. More that one Light object can be associated with a single MassAssign index (not shown in this example) -' Optionally, callbacks can be assigned for each index using the Lampz.Callback array. This is very useful for allowing 3D Insert primitives -' to be controlled by the ROM. Note, the aLvl parameter (i.e. the fading level that ranges between 0 and 1) is appended to the callback call. - -Dim NullFader : set NullFader = new NullFadingObject -Dim Lampz : Set Lampz = New LampFader -Dim FadingState(200) -InitLampsNF ' Setup lamp assignments -LampTimer.Interval = -1 -LampTimer.Enabled = 1 - -Sub LampTimer_Timer() - dim x, chglamp - if UsingROM then chglamp = Controller.ChangedLamps - If Not IsEmpty(chglamp) Then - For x = 0 To UBound(chglamp) 'nmbr = chglamp(x, 0), state = chglamp(x, 1) - Lampz.state(chglamp(x, 0)) = chglamp(x, 1) - FadingState(chgLamp(x, 0)) = chgLamp(x, 1) + 3 'fading step - next - End If - Lampz.Update2 'update (fading logic only) - UpdateLeds - UpdateTexts -End Sub - -Sub DisableLighting(pri, DLintensity, ByVal aLvl) 'cp's script DLintensity = disabled lighting intesity - if Lampz.UseFunction then aLvl = Lampz.FilterOut(aLvl) 'Callbacks don't get this filter automatically - pri.blenddisablelighting = aLvl * DLintensity -End Sub - -Sub SetModLamp(id, val) - Lampz.state(id) = val -End Sub - - -Sub InitLampsNF() - - 'Filtering (comment out to disable) - Lampz.Filter = "LampFilter" 'Puts all lamp intensityscale output (no callbacks) through this function before updating - - 'Adjust fading speeds (max level / full MS fading time). The Modulate property must be set to 1 / max level if lamp is modulated. - dim x : for x = 0 to 150 : Lampz.FadeSpeedUp(x) = 1/40 : Lampz.FadeSpeedDown(x) = 1/120 : Lampz.Modulate(x) = 1 : next - - - 'Lampz Assignments - ' In a ROM based table, the lamp ID is used to set the state of the Lampz objects - - 'MassAssign is an optional way to do assignments. It'll create arrays automatically / append objects to existing arrays - Lampz.MassAssign(1)= l1 - Lampz.MassAssign(2)= l2 - Lampz.MassAssign(3)= l3 - Lampz.MassAssign(4)= l4 - Lampz.MassAssign(5)= l5 - Lampz.MassAssign(6)= l6 - Lampz.MassAssign(7)= l7 - Lampz.MassAssign(8)= L8 - Lampz.MassAssign(9)= l9 - Lampz.MassAssign(10)= l10 - Lampz.MassAssign(11)= l11 - Lampz.MassAssign(12)= l12 - Lampz.MassAssign(13)= L13 - Lampz.MassAssign(13)= L13b - Lampz.MassAssign(14)= L14 - Lampz.MassAssign(14)= L14b - Lampz.MassAssign(15)= L15 - Lampz.MassAssign(15)= L15b - Lampz.MassAssign(16)= L16 - Lampz.MassAssign(17)= L17 - Lampz.MassAssign(19)= L19 - Lampz.MassAssign(20)= L20 - Lampz.MassAssign(21)= L21 - Lampz.MassAssign(22)= L22 - Lampz.MassAssign(23)= L23 - Lampz.MassAssign(24)= L24 - Lampz.MassAssign(25)= L25 - Lampz.MassAssign(25)= L25a - Lampz.MassAssign(26)= L26 - Lampz.MassAssign(26)= L26a - Lampz.MassAssign(27)= L27 - Lampz.MassAssign(27)= L27a - Lampz.MassAssign(28)= L28 - Lampz.MassAssign(29)= L29 - Lampz.MassAssign(30)= L30 - Lampz.MassAssign(31)= L31 - Lampz.MassAssign(32)= l32 - Lampz.MassAssign(33)= L33 - Lampz.MassAssign(34)= L34 - Lampz.MassAssign(35)= L35 - Lampz.MassAssign(36)= L36 - Lampz.MassAssign(37)= L37 - Lampz.MassAssign(38)= L38 - Lampz.MassAssign(39)= L39 - Lampz.MassAssign(40)= L40 - Lampz.MassAssign(41)= L41 - Lampz.MassAssign(41)= L41a - Lampz.MassAssign(42)= L42 - Lampz.MassAssign(42)= L42a - Lampz.MassAssign(43)= L43 - Lampz.MassAssign(43)= L43a - Lampz.MassAssign(44)= L44 - Lampz.MassAssign(44)= L44a - Lampz.MassAssign(45)= L45 - Lampz.MassAssign(45)= L45a - Lampz.MassAssign(46)= L46 - Lampz.MassAssign(46)= L46a - Lampz.MassAssign(47)= L47 - Lampz.MassAssign(47)= L47a - Lampz.MassAssign(48)= L48 - Lampz.MassAssign(49)= L49 - Lampz.MassAssign(50)= L50 - Lampz.MassAssign(51)= L51 - Lampz.MassAssign(52)= L52 - Lampz.MassAssign(53)= L53 - Lampz.MassAssign(55)= L55 - Lampz.MassAssign(56)= L56 - Lampz.MassAssign(73)= l73 - Lampz.MassAssign(74)= l74 - Lampz.MassAssign(75)= l75 - Lampz.MassAssign(76)= l76 - Lampz.MassAssign(80)= l80 - - - 'Turn off all lamps on startup - Lampz.Init 'This just turns state of any lamps to 1 - - 'Immediate update to turn on GI, turn off lamps - Lampz.Update - -End Sub - -Sub UpdateTexts() - 'backdrop lights - Textm 78, l78a, "OVER" - Text 78, l78, "GAME" - Text 80, l80, "TILT" -End Sub - -'Texts - -Sub Text(nr, object, message) - Select Case FadingState(nr) - Case 4:object.Text = message:FadingState(nr) = 0 - Case 3:object.Text = "":FadingState(nr) = 0 - End Select -End Sub - -Sub Textm(nr, object, message) - Select Case FadingState(nr) - Case 4:object.Text = message - Case 3:object.Text = "" - End Select -End Sub - -'==================== -'Class jungle nf -'==================== - -'No-op object instead of adding more conditionals to the main loop -'It also prevents errors if empty lamp numbers are called, and it's only one object -'should be g2g? - -Class NullFadingObject : Public Property Let IntensityScale(input) : : End Property : End Class - -'version 0.11 - Mass Assign, Changed modulate style -'version 0.12 - Update2 (single -1 timer update) update method for core.vbs -'Version 0.12a - Filter can now be accessed via 'FilterOut' -'Version 0.12b - Changed MassAssign from a sub to an indexed property (new syntax: lampfader.MassAssign(15) = Light1 ) -'Version 0.13 - No longer requires setlocale. Callback() can be assigned multiple times per index -' Note: if using multiple 'LampFader' objects, set the 'name' variable to avoid conflicts with callbacks -'Version 0.14 - Updated to support modulated signals - Niwak - -Class LampFader - Public FadeSpeedDown(150), FadeSpeedUp(150) - Private Lock(150), Loaded(150), OnOff(150) - Public UseFunction - Private cFilter - Public UseCallback(150), cCallback(150) - Public Lvl(150), Obj(150) - Private Mult(150) - Public FrameTime - Private InitFrame - Public Name - - Sub Class_Initialize() - InitFrame = 0 - dim x : for x = 0 to uBound(OnOff) 'Set up fade speeds - FadeSpeedDown(x) = 1/100 'fade speed down - FadeSpeedUp(x) = 1/80 'Fade speed up - UseFunction = False - lvl(x) = 0 - OnOff(x) = 0 - Lock(x) = True : Loaded(x) = False - Mult(x) = 1 - Next - Name = "LampFaderNF" 'NEEDS TO BE CHANGED IF THERE'S MULTIPLE OF THESE OBJECTS, OTHERWISE CALLBACKS WILL INTERFERE WITH EACH OTHER!! - for x = 0 to uBound(OnOff) 'clear out empty obj - if IsEmpty(obj(x) ) then Set Obj(x) = NullFader' : Loaded(x) = True - Next - End Sub - - Public Property Get Locked(idx) : Locked = Lock(idx) : End Property ''debug.print Lampz.Locked(100) 'debug - Public Property Get state(idx) : state = OnOff(idx) : end Property - Public Property Let Filter(String) : Set cFilter = GetRef(String) : UseFunction = True : End Property - Public Function FilterOut(aInput) : if UseFunction Then FilterOut = cFilter(aInput) Else FilterOut = aInput End If : End Function - 'Public Property Let Callback(idx, String) : cCallback(idx) = String : UseCallBack(idx) = True : End Property - Public Property Let Callback(idx, String) - UseCallBack(idx) = True - 'cCallback(idx) = String 'old execute method - 'New method: build wrapper subs using ExecuteGlobal, then call them - cCallback(idx) = cCallback(idx) & "___" & String 'multiple strings dilineated by 3x _ - - dim tmp : tmp = Split(cCallback(idx), "___") - - dim str, x : for x = 0 to uBound(tmp) 'build proc contents - 'If Not tmp(x)="" then str = str & " " & tmp(x) & " aLVL" & " '" & x & vbnewline 'more verbose - If Not tmp(x)="" then str = str & tmp(x) & " aLVL:" - Next - 'msgbox "Sub " & name & idx & "(aLvl):" & str & "End Sub" - dim out : out = "Sub " & name & idx & "(aLvl):" & str & "End Sub" - ExecuteGlobal Out - - End Property - - Public Property Let state(ByVal idx, input) 'Major update path - if TypeName(input) <> "Double" and typename(input) <> "Integer" and typename(input) <> "Long" then - If input Then - input = 1 - Else - input = 0 - End If - End If - if Input <> OnOff(idx) then 'discard redundant updates - OnOff(idx) = input - Lock(idx) = False - Loaded(idx) = False - End If - End Property - - 'Mass assign, Builds arrays where necessary - 'Sub MassAssign(aIdx, aInput) - Public Property Let MassAssign(aIdx, aInput) - If typename(obj(aIdx)) = "NullFadingObject" Then 'if empty, use Set - if IsArray(aInput) then - obj(aIdx) = aInput - Else - Set obj(aIdx) = aInput - end if - Else - Obj(aIdx) = AppendArray(obj(aIdx), aInput) - end if - end Property - - Sub SetLamp(aIdx, aOn) : state(aIdx) = aOn : End Sub 'Solenoid Handler - - Public Sub TurnOnStates() 'If obj contains any light objects, set their states to 1 (Fading is our job!) - dim debugstr - dim idx : for idx = 0 to uBound(obj) - if IsArray(obj(idx)) then - 'debugstr = debugstr & "array found at " & idx & "..." - dim x, tmp : tmp = obj(idx) 'set tmp to array in order to access it - for x = 0 to uBound(tmp) - if typename(tmp(x)) = "Light" then DisableState tmp(x)' : debugstr = debugstr & tmp(x).name & " state'd" & vbnewline - tmp(x).intensityscale = 0.001 ' this can prevent init stuttering - Next - Else - if typename(obj(idx)) = "Light" then DisableState obj(idx)' : debugstr = debugstr & obj(idx).name & " state'd (not array)" & vbnewline - obj(idx).intensityscale = 0.001 ' this can prevent init stuttering - end if - Next - ''debug.print debugstr - End Sub - Private Sub DisableState(ByRef aObj) : aObj.FadeSpeedUp = 1000 : aObj.State = 1 : End Sub 'turn state to 1 - - Public Sub Init() 'Just runs TurnOnStates right now - TurnOnStates - End Sub - - Public Property Let Modulate(aIdx, aCoef) : Mult(aIdx) = aCoef : Lock(aIdx) = False : Loaded(aIdx) = False: End Property - Public Property Get Modulate(aIdx) : Modulate = Mult(aIdx) : End Property - - Public Sub Update1() 'Handle all boolean numeric fading. If done fading, Lock(x) = True. Update on a '1' interval Timer! - dim x : for x = 0 to uBound(OnOff) - if not Lock(x) then 'and not Loaded(x) then - if OnOff(x) > 0 then 'Fade Up - Lvl(x) = Lvl(x) + FadeSpeedUp(x) - if Lvl(x) >= OnOff(x) then Lvl(x) = OnOff(x) : Lock(x) = True - else 'fade down - Lvl(x) = Lvl(x) - FadeSpeedDown(x) - if Lvl(x) <= 0 then Lvl(x) = 0 : Lock(x) = True - end if - end if - Next - End Sub - - Public Sub Update2() 'Both updates on -1 timer (Lowest latency, but less accurate fading at 60fps vsync) - FrameTime = gametime - InitFrame : InitFrame = GameTime 'Calculate frametime - dim x : for x = 0 to uBound(OnOff) - if not Lock(x) then 'and not Loaded(x) then - if OnOff(x) > 0 then 'Fade Up - Lvl(x) = Lvl(x) + FadeSpeedUp(x) * FrameTime - if Lvl(x) >= OnOff(x) then Lvl(x) = OnOff(x) : Lock(x) = True - else 'fade down - Lvl(x) = Lvl(x) - FadeSpeedDown(x) * FrameTime - if Lvl(x) <= 0 then Lvl(x) = 0 : Lock(x) = True - end if - end if - Next - Update - End Sub - - Public Sub Update() 'Handle object updates. Update on a -1 Timer! If done fading, loaded(x) = True - dim x,xx, aLvl : for x = 0 to uBound(OnOff) - if not Loaded(x) then - aLvl = Lvl(x)*Mult(x) - if IsArray(obj(x) ) Then 'if array - If UseFunction then - for each xx in obj(x) : xx.IntensityScale = cFilter(aLvl) : Next - Else - for each xx in obj(x) : xx.IntensityScale = aLvl : Next - End If - else 'if single lamp or flasher - If UseFunction then - obj(x).Intensityscale = cFilter(aLvl) - Else - obj(x).Intensityscale = aLvl - End If - end if - 'if TypeName(lvl(x)) <> "Double" and typename(lvl(x)) <> "Integer" and typename(lvl(x)) <> "Long" then msgbox "uhh " & 2 & " = " & lvl(x) - 'If UseCallBack(x) then execute cCallback(x) & " " & (Lvl(x)) 'Callback - If UseCallBack(x) then Proc name & x,aLvl 'Proc - If Lock(x) Then - if Lvl(x) = OnOff(x) or Lvl(x) = 0 then Loaded(x) = True 'finished fading - end if - end if - Next - End Sub -End Class - - -'Lamp Filter -Function LampFilter(aLvl) - LampFilter = aLvl^1.6 'exponential curve? -End Function - - -'Helper functions -Sub Proc(string, Callback) 'proc using a string and one argument - 'On Error Resume Next - dim p : Set P = GetRef(String) - P Callback - If err.number = 13 then msgbox "Proc error! No such procedure: " & vbnewline & string - if err.number = 424 then msgbox "Proc error! No such Object" -End Sub - -Function AppendArray(ByVal aArray, aInput) 'append one value, object, or Array onto the end of a 1 dimensional array - if IsArray(aInput) then 'Input is an array... - dim tmp : tmp = aArray - If not IsArray(aArray) Then 'if not array, create an array - tmp = aInput - Else 'Append existing array with aInput array - Redim Preserve tmp(uBound(aArray) + uBound(aInput)+1) 'If existing array, increase bounds by uBound of incoming array - dim x : for x = 0 to uBound(aInput) - if isObject(aInput(x)) then - Set tmp(x+uBound(aArray)+1 ) = aInput(x) - Else - tmp(x+uBound(aArray)+1 ) = aInput(x) - End If - Next - AppendArray = tmp 'return new array - End If - Else 'Input is NOT an array... - If not IsArray(aArray) Then 'if not array, create an array - aArray = Array(aArray, aInput) - Else - Redim Preserve aArray(uBound(aArray)+1) 'If array, increase bounds by 1 - if isObject(aInput) then - Set aArray(uBound(aArray)) = aInput - Else - aArray(uBound(aArray)) = aInput - End If - End If - AppendArray = aArray 'return new array - End If -End Function - -'****************************************************** -'**** END LAMPZ -'****************************************************** - - -'****************************************************** -' LUT -'****************************************************** - -Sub SetLUT 'AXS - Table1.ColorGradeImage = "LUT" & LUTset - -end sub - -Sub LUTBox_Timer - LUTBox.TimerEnabled = 0 - LUTBox.Visible = 0 - -End Sub - -Sub ShowLUT - LUTBox.visible = 1 - - Select Case LUTSet - Case 0: LUTBox.text = "Fleep Natural Dark 1" - Case 1: LUTBox.text = "Fleep Natural Dark 2" - Case 2: LUTBox.text = "Fleep Warm Dark" - Case 3: LUTBox.text = "koke, lut 70" - Case 4: LUTBox.text = "Fleep Warm Vivid Soft" - Case 5: LUTBox.text = "Fleep Warm Vivid Hard" - Case 6: LUTBox.text = "Skitso Natural and Balanced" - Case 7: LUTBox.text = "Skitso Natural High Contrast" - Case 8: LUTBox.text = "Mikeleonheart, lut 80" - Case 9: LUTBox.text = "CalleV Punchy Brightness and Contrast" - Case 10: LUTBox.text = "HauntFreaks Desaturated" - Case 11: LUTBox.text = "Tomate washed out" - Case 12: LUTBox.text = "VPW original 1on1" - Case 13: LUTBox.text = "bassgeige" - Case 14: LUTBox.text = "blacklight" - Case 15: LUTBox.text = "B&W Comic Book" - Case 16: LUTBox.text = "Skitso New Warmer LUT" - Case 17: LUTBox.text = "Original LUT" - End Select - - LUTBox.TimerEnabled = 1 - -End Sub - -Sub SaveLUT - Dim FileObj - Dim ScoreFile - - Set FileObj=CreateObject("Scripting.FileSystemObject") - If Not FileObj.FolderExists(UserDirectory) then - Exit Sub - End if - - if LUTset = "" then LUTset = 17 'failsafe to original - - Set ScoreFile=FileObj.CreateTextFile(UserDirectory & "Sorcerer_LUT.txt",True) - ScoreFile.WriteLine LUTset - Set ScoreFile=Nothing - Set FileObj=Nothing -End Sub - -Sub LoadLUT - Dim FileObj, ScoreFile, TextStr - dim rLine - - Set FileObj=CreateObject("Scripting.FileSystemObject") - If Not FileObj.FolderExists(UserDirectory) then - LUTset=17 - Exit Sub - End if - If Not FileObj.FileExists(UserDirectory & "Sorcerer_LUT.txt") then - LUTset=17 - Exit Sub - End if - Set ScoreFile=FileObj.GetFile(UserDirectory & "Sorcerer_LUT.txt") - Set TextStr=ScoreFile.OpenAsTextStream(1,0) - If (TextStr.AtEndOfStream=True) then - Exit Sub - End if - rLine = TextStr.ReadLine - If rLine = "" then - LUTset=17 - Exit Sub - End if - LUTset = int (rLine) - Set ScoreFile = Nothing - Set FileObj = Nothing -End Sub - -Sub ShowLUT_Init - LUTBox.visible = 0 - -End Sub - - - - - - diff --git a/Pole Position (Sonic 1987)2.0/Pole Position (Sonic 1987)2.0.vbs.original b/Pole Position (Sonic 1987)2.0/Pole Position (Sonic 1987)2.0.vbs.original deleted file mode 100644 index e02f82b..0000000 --- a/Pole Position (Sonic 1987)2.0/Pole Position (Sonic 1987)2.0.vbs.original +++ /dev/null @@ -1,3568 +0,0 @@ -' *********************************************************************** -' ____ ___ _ _____ ____ ___ ____ ___ _____ ___ ___ _ _ -' | _ \ / _ \ | | | ____| | _ \ / _ \ / ___| |_ _| |_ _| |_ _| / _ \ | \ | | -' | |_) | | | | | | | | _| | |_) | | | | | \___ \ | | | | | | | | | | | \| | -' | __/ | |_| | | |___ | |___ | __/ | |_| | ___) | | | | | | | | |_| | | |\ | -' |_| \___/ |_____| |_____| |_| \___/ |____/ |___| |_| |___| \___/ |_| \_| -' -' *********************************************************************** -' Pole Position (Sonic 1987) -' **** -' -' Pole Position / IPD No. 3322 / 1987 / 4 Players -' Solid State Electronic (SS) -' VPX version by NestorGian. Build in 08/2022, version 1.0 -' Art:Pedator (plaifield and plastics) -' Akiles (backglass image) - -' *********************************************************************** -' - nFozzy Physics, FleepSounds, DropTargets by Rothbaurw -' - Dynamic Ballshadows, Slingshot Corrections, LUT selector -' *********************************************************************** - - Option Explicit - Randomize - -'******************************************* -' User Options -'******************************************* - -'----- Shadow Options ----- -Const DynamicBallShadowsOn = 1 '0 = no dynamic ball shadow ("triangles" near slings and such), 1 = enable dynamic ball shadow -Const AmbientBallShadowOn = 1 '0 = Static shadow under ball ("flasher" image, like JP's) - '1 = Moving ball shadow ("primitive" object, like ninuzzu's) - This is the only one that shows up on the pf when in ramps and fades when close to lights! - '2 = flasher image shadow, but it moves like ninuzzu's - -'----- General Sound Options ----- -Const VolumeDial = 0.8 'Overall Mechanical sound effect volume. Recommended values should be no greater than 1. -Const BallRollVolume = 0.6 'Level of ball rolling volume. Value between 0 and 1 -Const RampRollVolume = 0.8 'Level of ramp rolling volume. Value between 0 and 1 - - -'******************************************* -' Constants and Global Variables -'******************************************* - -Const UsingROM = True 'The UsingROM flag is to indicate code that requires ROM usage. Mostly for instructional purposes only. - -Const BallSize = 50 'Ball size must be 50 -Const BallMass = 1 'Ball mass must be 1 -Const tnob = 1 'Total number of balls -Const lob = 0 'Locked balls - -Dim tablewidth: tablewidth = Table1.width -Dim tableheight: tableheight = Table1.height - -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 "01560000", "peyper.vbs", 3.26 - -Const cgamename = "poleposn", UseSolenoids=2, UseLamps=0,UseGI=0, SCoin="coin" - - -If Table1.ShowDT = true then - For each x in aReels - x.Visible = 1 - Next -else - For each x in aReels - x.Visible = 0 - Next -end if - -Dim LUTset, DisableLUTSelector, LutToggleSound, LutToggleSoundLevel -LutToggleSound = True -LutToggleSoundLevel = .1 - -LoadLUT - -'LUTset = 17 ' Override saved LUT for debug - -SetLUT -ShowLUT_Init - -DisableLUTSelector = 0 ' Disables the ability to change LUT option with magna saves in game when set to 1 - - - -'************************************************************* -'Solenoid Call backs -'********************************************************************************************************** - -'SolCallback(1)="vpmSolSound ""bumper""," -'SolCallback(2)="vpmSolSound ""bumper""," -'SolCallback(3)="vpmSolSound ""Slingshot""," -'SolCallback(4)="vpmSolSound ""Slingshot""," - SolCallback(7) = "SolKnocker" 'Credit Knocker - SolCallback(8) = "solrelease" - SolCallback(30) = "vpmNudge.SolGameOn" - SolCallback(31) = "PFGI" - - SolCallback(sLRFlipper) = "SolRFlipper" - SolCallback(sLLFlipper) = "SolLFlipper" - - - -'******************************************* -' Flippers -'******************************************* - -Const ReflipAngle = 20 - -' Flipper Solenoid Callbacks (these subs mimics how you would handle flippers in ROM based tables) -Sub SolLFlipper(Enabled) - If Enabled Then - LF.Fire '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 - - If rightflipper.currentangle > rightflipper.endangle - ReflipAngle Then - RandomSoundReflipUpRight RightFlipper - Else - SoundFlipperUpAttackRight RightFlipper - RandomSoundFlipperUpRight RightFlipper - End If - Else - RightFlipper.RotateToStart - If RightFlipper.currentangle > RightFlipper.startAngle + 5 Then - RandomSoundFlipperDownRight RightFlipper - End If - FlipperRightHitParm = FlipperUpSoundLevel - End If -End Sub - - -' Flipper collide subs -Sub LeftFlipper_Collide(parm) - CheckLiveCatch Activeball, LeftFlipper, LFCount, parm - LeftFlipperCollide parm -End Sub - -Sub RightFlipper_Collide(parm) - CheckLiveCatch Activeball, RightFlipper, RFCount, parm - RightFlipperCollide parm -End Sub - - -' This subroutine updates the flipper shadows and visual primitives -Sub FlipperVisualUpdate - FlipperLSh.RotZ = LeftFlipper.CurrentAngle - FlipperRSh.RotZ = RightFlipper.CurrentAngle -End Sub - - - -'********************************************************************************************************** -'GI -'********************************************************************************************************** - -dim gilvl:gilvl = 1 'General Illumination light state tracked for Dynamic Ball Shadows - -Sub PFGI(Enabled) - If Enabled Then - dim xx - For each xx in GI:xx.State = 0: Next - FlasherGI.visible = 0 - gilvl = 0 - Else - For each xx in GI:xx.State = 1: Next - FlasherGI.visible = 1 - gilvl = 1 - End If - Sound_GI_Relay enabled, bumper1 -End Sub - - -'******************************************* -' Timers -'******************************************* - - -Sub GameTimer_Timer - Cor.Update 'update ball tracking (this sometimes goes in the RDampen_Timer sub) - RollingUpdate 'update rolling sounds - DoSTAnim 'handle stand up target animations -End Sub - -' The frame timer interval is -1, so executes at the display frame rate -dim FrameTime, InitFrameTime : InitFrameTime = 0 - -Sub FrameTimer_Timer() - FrameTime = gametime - InitFrameTime : InitFrameTime = gametime 'Count frametime - FlipperVisualUpdate 'update flipper shadows and primitives - If DynamicBallShadowsOn Or AmbientBallShadowOn Then DynamicBSUpdate 'update ball shadows -End Sub - - -'******************************************* -' Table Initialization and Exiting -'******************************************* - - Dim bsTrough - Dim x, ii - Dim PPBall1, BOT - -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 = "Pole Position - Sonic 1987"&chr(13)&"IT'S FREE" - .HandleMechanics=0 - .HandleKeyboard=0 - .ShowDMDOnly=1 - .ShowFrame=0 - .ShowTitle=0 - .hidden = 1 - Games(cGameName).Settings.Value("sound")=1 - '.PuPHide = 1 - On Error Resume Next - .Run GetPlayerHWnd - If Err Then MsgBox Err.Description - On Error Goto 0 - End With - On Error Goto 0 - - vpmNudge.TiltSwitch = - 5 - vpmNudge.Sensitivity = 5 - vpmNudge.TiltObj = Array(bumper1, bumper2, LeftSlingshot, RightSlingshot) - - - Set PPBall1 = Drain.CreateSizedballWithMass(Ballsize/2,Ballmass) - Controller.Switch(0.1) = 1 - - - ' Main Timer init - PinMAMETimer.Interval = PinMAMEInterval - PinMAMETimer.Enabled = 1 - GameTimer.Enabled = 1 - -' For x = 1 to 78 : DisplayLamps x, 0 : Next -' Leds.Enabled = 1 - LoadLUT - End Sub - - Sub table1_Paused : Controller.Pause = 1 : End Sub - Sub table1_unPaused : Controller.Pause = 0 : End Sub - Sub table1_exit:Controller.Pause = False:Controller.Stop:SaveLUT:End Sub - - - -'******************************************* -' Drain -'******************************************* - - - -' DRAIN & RELEASE -Sub Drain_Hit - RandomSoundDrain Drain - Controller.Switch(0.1) = 1 -' bsTrough.AddBall Me -End Sub - -Sub SolRelease(enabled) - If enabled Then - RandomSoundBallRelease Drain - Drain.kick 60, 20 - Controller.Switch(0.1) = 0 - End If -End Sub - - - '********** - ' Keys - '********** -Dim BIPL : BIPL = 0 - -Sub table1_KeyDown(ByVal Keycode) - - If keycode = LeftFlipperKey Then - FlipperActivate LeftFlipper, LFPress - Controller.Switch(103) = 1 - End If - - If keycode = RightFlipperKey Then - FlipperActivate RightFlipper, RFPress - Controller.Switch(101) = 1 - End If - - If keycode = LeftTiltKey Then Nudge 90, 1:SoundNudgeLeft() - If keycode = RightTiltKey Then Nudge 270, 1:SoundNudgeRight() - If keycode = CenterTiltKey Then Nudge 0, 1:SoundNudgeCenter() - If keycode = StartGameKey then SoundStartButton() - 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 = PlungerKey Then - Plunger.Pullback - SoundPlungerPull() - End if -' iluminación - If keycode = RightMagnaSave Then 'AXS 'Fleep - if DisableLUTSelector = 0 then - If LutToggleSound Then - Playsound "click", 0, LutToggleSoundLevel * VolumeDial, 0, 0.2, 0, 0, 0, 1 - End If - LUTSet = LUTSet + 1 - if LutSet > 17 then LUTSet = 0 - SetLUT - ShowLUT - end if - end if - If keycode = LeftMagnaSave Then - if DisableLUTSelector = 0 then - If LutToggleSound Then - Playsound "click", 0, LutToggleSoundLevel * VolumeDial, 0, 0.2, 0, 0, 0, 1 - End If - LUTSet = LUTSet - 1 - if LutSet < 0 then LUTSet = 17 - SetLUT - ShowLUT - end if - End If - If KeyDownHandler(KeyCode) Then Exit Sub -' If vpmKeyDown(keycode) Then Exit Sub - End Sub - - Sub table1_KeyUp(ByVal Keycode) - - If keycode = LeftFlipperKey Then - FlipperDeActivate LeftFlipper, LFPress - Controller.Switch(103) = 0 - End If - - If keycode = RightFlipperKey Then - FlipperDeActivate RightFlipper, RFPress - Controller.Switch(101) = 0 - End If - -' If keycode = PlungerKey Then Plunger.Fire:PlaySound"plunger" - 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 - - If vpmKeyUp(keycode) Then Exit Sub - End Sub - - - '********* - ' Switches - '********* - - -'**************************************************************** -' Slingshots -'**************************************************************** - -' RStep and LStep are the variables that increment the animation -Dim RStep, LStep, GStep - -Sub RightSlingShot_Slingshot - vpmTimer.PulseSw 3 'Slingshot Rom Switch - RS.VelocityCorrect(ActiveBall) - RSling1.Visible = 1 - Sling1.TransY = -20 'Sling Metal Bracket - RStep = 0 - RightSlingShot.TimerEnabled = 1 - RightSlingShot.TimerInterval = 1 - RandomSoundSlingshotRight Sling1 -End Sub - -Sub RightSlingShot_Timer - Select Case RStep - Case 3:RSLing1.Visible = 0:RSLing2.Visible = 1:Sling1.TransY = -10 - Case 4:RSLing2.Visible = 0:Sling1.TransY = 0:RightSlingShot.TimerEnabled = 0 - End Select - RStep = RStep + 1 -End Sub - -Sub LeftSlingShot_Slingshot - vpmTimer.PulseSw 4 'Slingshot Rom Switch - LS.VelocityCorrect(ActiveBall) - LSling1.Visible = 1 - Sling2.TransY = -20 'Sling Metal Bracket - LStep = 0 - LeftSlingShot.TimerEnabled = 1 - LeftSlingShot.TimerInterval = 10 - RandomSoundSlingshotLeft Sling2 -End Sub - -Sub LeftSlingShot_Timer - Select Case LStep - Case 3:LSLing1.Visible = 0:LSLing2.Visible = 1:Sling2.TransY = -10 - Case 4:LSLing2.Visible = 0:Sling2.TransY = 0:LeftSlingShot.TimerEnabled = 0 - End Select - LStep = LStep + 1 -End Sub - -Sub TestSlingShot_Slingshot - TS.VelocityCorrect(ActiveBall) -End Sub - - - - - -' Rubber Walls -Sub sw12a_Slingshot : PlaySound "Rubber" : vpmTimer.PulseSw 21 : End Sub -Sub sw12b_Slingshot : PlaySound "Rubber" : vpmTimer.PulseSw 21 : End Sub -Sub sw2a_Slingshot : PlaySound "Rubber" : vpmTimer.PulseSw 10 : End Sub -Sub sw2b_Slingshot : PlaySound "Rubber" : vpmTimer.PulseSw 10 : End Sub - - ' Bumpers - -Sub Bumper1_Hit : vpmTimer.PulseSw(2) : RandomSoundBumperTop bumper1: End Sub -Sub Bumper2_Hit : vpmTimer.PulseSw(1) : RandomSoundBumperMiddle bumper2: End Sub - - -' Drain holes & saucers - - - ' Rollovers - Sub sw26_Hit :Controller.Switch(37) = 1 :sw26wire.RotX = 15 :ActivarFreno1: End Sub - Sub sw26_UnHit:Controller.Switch(37) = 0 :sw26wire.RotX = 0 : End Sub - - Sub sw27_Hit :Controller.Switch(36) = 1 :sw27wire.RotX = 15 : End Sub - Sub sw27_UnHit:Controller.Switch(36) = 0 :sw27wire.RotX = 0 : End Sub - - Sub sw30_Hit :Controller.Switch(26) = 1 :sw30wire.RotX = 15 : End Sub - Sub sw30_UnHit:Controller.Switch(26) = 0 :sw30wire.RotX = 0 : End Sub - - Sub sw31_Hit :Controller.Switch(27) = 1 :sw31wire.RotX = 15 :ActivarFreno1: End Sub - Sub sw31_UnHit:Controller.Switch(27) = 0 :sw31wire.RotX = 0 : End Sub - - Sub sw24b_Hit :Controller.Switch(35) = 1 :sw24bwire.RotX = 15 : End Sub - Sub sw24b_UnHit:Controller.Switch(35) = 0 :sw24bwire.RotX = 0 : End Sub - - Sub sw24a_Hit :Controller.Switch(35) = 1 :sw24awire.RotX = 15 : End Sub - Sub sw24a_UnHit:Controller.Switch(35) = 0 :sw24awire.RotX = 0 : End Sub - - Sub sw16_Hit :Controller.Switch(34) = 1 :sw16wire.RotX = 15 : End Sub - Sub sw16_UnHit:Controller.Switch(34) = 0 :sw16wire.RotX = 0 : End Sub - - Sub sw15_Hit :Controller.Switch(24) = 1 :sw15wire.RotX = 15 : End Sub - Sub sw15_UnHit:Controller.Switch(24) = 0 :sw15wire.RotX = 0 : End Sub - - Sub sw3_Hit :Controller.Switch(11) = 1 :sw3wire.RotX = 15 : End Sub - Sub sw3_UnHit:Controller.Switch(11) = 0 :sw3wire.RotX = 0 : End Sub - - Sub sw4_Hit :Controller.Switch(12) = 1 :sw4wire.RotX = 15 : End Sub - Sub sw4_UnHit:Controller.Switch(12) = 0 :sw4wire.RotX = 0 : End Sub - - Sub sw5_Hit :Controller.Switch(13) = 1 :sw5wire.RotX = 15 : End Sub - Sub sw5_UnHit:Controller.Switch(13) = 0 :sw5wire.RotX = 0 : End Sub - - Sub sw1_Hit :Controller.Switch(6) = 1 :sw1wire.RotX = 15 : End Sub - Sub sw1_UnHit:Controller.Switch(6) = 0 :sw1wire.RotX = 0 : End Sub - -Sub Gate4_Hit :ActivarFreno2: End Sub -Sub Gate5_Hit :ActivarFreno2: End Sub - -Sub ActivarFreno1() - If ActiveBall.VelY > 7 then ActiveBall.VelY = 7 - End Sub - - Sub ActivarFreno2() - If ActiveBall.VelY > 3 then ActiveBall.VelY = 5 - End Sub - - ' Targets - Sub sw6_Hit :vpmTimer.PulseSw 14:STHit 6: End Sub - Sub sw7_Hit :vpmTimer.PulseSw 15:STHit 7: End Sub - Sub sw8_Hit :vpmTimer.PulseSw 16:STHit 8: End Sub - Sub sw9_Hit :vpmTimer.PulseSw 17:STHit 9: End Sub - Sub sw11_Hit :vpmTimer.PulseSw 20:STHit 11: End Sub - Sub sw17_Hit :vpmTimer.PulseSw 22:STHit 17: End Sub - Sub sw18_Hit :vpmTimer.PulseSw 23:STHit 18: End Sub - Sub sw25_Hit :vpmTimer.PulseSw 25:STHit 25: End Sub - Sub sw20_Hit :vpmTimer.PulseSw 30:STHit 20: End Sub - Sub sw21_Hit :vpmTimer.PulseSw 31:STHit 21: End Sub - Sub sw22_Hit :vpmTimer.PulseSw 32:STHit 22: End Sub - Sub sw23_Hit :vpmTimer.PulseSw 33:STHit 23: End Sub - - - ' Gates - Sub Gate2_Hit : vpmTimer.PulseSw 5 : End Sub - - 'Spinners - Sub Spinner3_Spin : vpmTimer.PulseSw 7 : SoundSpinner Spinner3 : End Sub - - - ' Gate-Diverter - Dim DivOn, Gatediv - - Sub DivHelp_Hit() : GatePrim.Enabled = 1: Gatediv = 1: GatePri.Collidable = False: End Sub - - - Sub GatePrim_Timer - Select Case Gatediv - Case 1:GatePri.RotZ = 65 - Case 2:GatePri.RotZ = 70 - Case 3:GatePri.RotZ = 75 - Case 4:GatePri.RotZ = 80 - Case 5:GatePri.RotZ = 85: - Case 6:vpmtimer.addtimer 400,"GatePri.RotZ = 60:GatePri.Collidable = True'": GatePrim.Enabled = 0 - End Select - Gatediv = Gatediv + 1 - End Sub - - -Sub GateL_Hit() - GateLong.RotZ = -45 - GStep = 0 - GateL.TimerEnabled = 1 -End Sub - -Sub GateL_Timer - Select Case GStep - Case 1:GateLong.RotZ = 0 - Case 2:GateLong.RotZ = -30 - Case 3:GateLong.RotZ = -70:GateL.TimerEnabled = 0 - End Select - GStep = GStep + 1 -End Sub - - -Sub swPlunger_Hit: BIPL=1 :End Sub -Sub swPlunger_UnHit: BIPL=0 :End Sub - - -'******************************************* -' Ramp Triggers -'******************************************* - -Sub ramptrigger01_hit() - WireRampOn False 'Play Wire Ramp Sound -End Sub - -Sub ramptrigger02_hit() - WireRampOff ' Turn off the Plastic Ramp Sound -End Sub - -Sub ramptrigger03_hit() - WireRampOn False 'Play Wire Ramp Sound -End Sub - -Sub ramptrigger04_hit() - WireRampOff ' Turn off the Plastic Ramp Sound -End Sub - - -'******************************************* -' Knocker Solenoid -'******************************************* - -Sub SolKnocker(Enabled) - If enabled Then - KnockerSolenoid - End If -End Sub - - '************************************ -' LEDs Display -' Based on Scapino's LEDs -'************************************ - -Dim Digits(33) -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) = f0 -Set Digits(31) = f1 -Set Digits(32) = f2 - - -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 - - '************* - ' Update Lamps - '************* - - 'Sonic Pole Position - 'added by Inkochnito - Sub editDips - Dim vpmDips : Set vpmDips = New cvpmDips - With vpmDips - .AddForm 700, 280, "Pole Position - DIP switches" - .AddFrame 205, 0, 190, "Coins per game", &H00000018, Array("1-5-2", 0, "1-6-3", &H00000008, "2-8-4", &H00000010, "(2x)1-3-1", &H00000018) 'dip 12&13 (4&5) - .AddFrame 205, 75, 190, "Score threshold", &H00000003, Array("3,900,000 points", &H00000003, "3,500,000 points", &H00000002, "3,200,000 points", &H00000001, "3,000,000 points", 0) 'dip 16&15 (1&2) - .AddFrame 0, 75, 190, "Balls per game", &H00000004, Array("3 balls", 0, "5 balls", &H00000004) 'dip 14 (3) - .AddFrame 0, 0, 190, "Bonus multiplier", &H00000300, Array("3X", &H00000400, "3X && 6X", &H00000200, "3X && 6X && 9X", &H00000100, "3X && 6X && 9X && 12X", 0) 'dip 7&8 (10&9) - .AddChk 0, 125, 150, Array("Match feature off", &H00000040) 'dip 10 (7) - .AddChk 0, 140, 150, Array("Attract mode off", &H00000020) 'dip 11 (6) - .AddChk 0, 155, 150, Array("Test", 32768) 'dip 1 (16) - .AddChk 0, 170, 150, Array("Erase memory", &H00002000) 'dip 3 (14) - '.AddChk 0,155,150,Array("NU",&H00001000)'dip 4 (13) - '.AddChk 0,115,150,Array("NU",&H00000400)'dip 6 (11) - '.AddChk 0,150,150,Array("NU",&H00000080)'dip 9 (8) - '.AddChk 0,195,150,Array("NU",&H00000800)'dip 5 (12) - '.AddChk 0,125,150,Array("NU",&H00004000)'dip 2 (15) - .AddLabel 0, 300, 280, 20, "After hitting OK, press F3 to reset game with new settings." - .ViewDips - End With - End Sub - - 'Set LampCallback = GetRef("UpdateLamps") - Set vpmShowDips = GetRef("editDips") - - - -'*************************************************************** -'**** VPW DYNAMIC BALL SHADOWS by Iakki, Apophis, and Wylte -'*************************************************************** - -'****** INSTRUCTIONS please read ****** - -'****** Part A: Table Elements ****** -' -' Import the "bsrtx7" and "ballshadow" images -' Import the shadow materials file (3 sets included) (you can also export the 3 sets from this table to create the same file) -' Copy in the BallShadowA flasher set and the sets of primitives named BallShadow#, RtxBallShadow#, and RtxBall2Shadow# -' * Count from 0 up, with at least as many objects each as there can be balls, including locked balls. You'll get an "eval" warning if tnob is higher -' * Warning: If merging with another system (JP's ballrolling), you may need to check tnob math and add an extra BallShadowA# flasher (out of range error) -' Ensure you have a timer with a -1 interval that is always running -' Set plastic ramps DB to *less* than the ambient shadows (-10000) if you want to see the pf shadow through the ramp - -' Create a collection called DynamicSources that includes all light sources you want to cast ball shadows -' It's recommended that you be selective in which lights go in this collection, as there are limitations: -' 1. The shadows can "pass through" solid objects and other light sources, so be mindful of where the lights would actually able to cast shadows -' 2. If there are more than two equidistant sources, the shadows can suddenly switch on and off, so places like top and bottom lanes need attention -' 3. At this time the shadows get the light on/off from tracking gilvl, so if you have lights you want shadows for that are on at different times you will need to either: -' a) remove this restriction (shadows think lights are always On) -' b) come up with a custom solution (see TZ example in script) -' After confirming the shadows work in general, use ball control to move around and look for any weird behavior - -'****** End Part A: Table Elements ****** - - -'****** Part B: Code and Functions ****** - -' *** Timer sub -' The "DynamicBSUpdate" sub should be called by a timer with an interval of -1 (framerate) -' Example timer sub: - -'Sub FrameTimer_Timer() -' If DynamicBallShadowsOn Or AmbientBallShadowOn Then DynamicBSUpdate 'update ball shadows -'End Sub - -' *** These are usually defined elsewhere (ballrolling), but activate here if necessary -'Const tnob = 10 ' total number of balls -'Const lob = 0 'locked balls on start; might need some fiddling depending on how your locked balls are done -'Dim tablewidth: tablewidth = Table1.width -'Dim tableheight: tableheight = Table1.height - -' *** User Options - Uncomment here or move to top for easy access by players -'----- Shadow Options ----- -'Const DynamicBallShadowsOn = 1 '0 = no dynamic ball shadow ("triangles" near slings and such), 1 = enable dynamic ball shadow -'Const AmbientBallShadowOn = 1 '0 = Static shadow under ball ("flasher" image, like JP's) -' '1 = Moving ball shadow ("primitive" object, like ninuzzu's) - This is the only one that shows up on the pf when in ramps and fades when close to lights! -' '2 = flasher image shadow, but it moves like ninuzzu's - -' *** This segment goes within the RollingUpdate sub, so that if Ambient...=0 and Dynamic...=0 the entire DynamicBSUpdate sub can be skipped for max performance -' *** Change BOT to BOT if using existing getballs code -' *** Includes lines commonly found there, for reference: -' ' stop the sound of deleted balls -' For b = UBound(BOT) + 1 to tnob -' If AmbientBallShadowOn = 0 Then BallShadowA(b).visible = 0 -' ...rolling(b) = False -' ...StopSound("BallRoll_" & b) -' Next -' -' ...rolling and drop sounds... - -' If DropCount(b) < 5 Then -' DropCount(b) = DropCount(b) + 1 -' End If -' -' ' "Static" Ball Shadows -' If AmbientBallShadowOn = 0 Then -' If BOT(b).Z > 30 Then -' BallShadowA(b).height=BOT(b).z - BallSize/4 'This is technically 1/4 of the ball "above" the ramp, but it keeps it from clipping the ramp -' Else -' BallShadowA(b).height=BOT(b).z - BallSize/2 + 5 -' End If -' BallShadowA(b).Y = BOT(b).Y + Ballsize/5 + offsetY -' BallShadowA(b).X = BOT(b).X + offsetX -' BallShadowA(b).visible = 1 -' End If - -' *** Required Functions, enable these if they are not already present elswhere in your table -Function max(a,b) - if a > b then - max = a - Else - max = b - end if -end Function - -'Function Distance(ax,ay,bx,by) -' Distance = SQR((ax - bx)^2 + (ay - by)^2) -'End Function - -'Dim PI: PI = 4*Atn(1) - -'Function Atn2(dy, dx) -' 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 - -'Function AnglePP(ax,ay,bx,by) -' AnglePP = Atn2((by - ay),(bx - ax))*180/PI -'End Function - -'****** End Part B: Code and Functions ****** - - -'****** Part C: The Magic ****** - -' *** These define the appearance of shadows in your table *** - -'Ambient (Room light source) -Const AmbientBSFactor = 0.9 '0 to 1, higher is darker -Const AmbientMovement = 2 '1 to 4, higher means more movement as the ball moves left and right -Const offsetX = 0 'Offset x position under ball (These are if you want to change where the "room" light is for calculating the shadow position,) -Const offsetY = 0 'Offset y position under ball (for example 5,5 if the light is in the back left corner) -'Dynamic (Table light sources) -Const DynamicBSFactor = 0.95 '0 to 1, higher is darker -Const Wideness = 20 'Sets how wide the dynamic ball shadows can get (20 +5 thinness is technically most accurate for lights at z ~25 hitting a 50 unit ball) -Const Thinness = 5 'Sets minimum as ball moves away from source - -' *** *** - -' *** Trim or extend these to *match* the number of balls/primitives/flashers on the table! -dim objrtx1(5), objrtx2(5) -dim objBallShadow(5) -Dim BallShadowA -BallShadowA = Array (BallShadowA0,BallShadowA1,BallShadowA2,BallShadowA3,BallShadowA4) -Dim DSSources(30), numberofsources', DSGISide(30) 'Adapted for TZ with GI left / GI right - -'Initialization -DynamicBSInit - -sub DynamicBSInit() - Dim iii, source - - for iii = 0 to tnob - 1 'Prepares the shadow objects before play begins - Set objrtx1(iii) = Eval("RtxBallShadow" & iii) - objrtx1(iii).material = "RtxBallShadow" & iii - objrtx1(iii).z = 1 + iii/1000 + 0.01 'Separate z for layering without clipping - objrtx1(iii).visible = 0 - - Set objrtx2(iii) = Eval("RtxBall2Shadow" & iii) - objrtx2(iii).material = "RtxBallShadow2_" & iii - objrtx2(iii).z = 1 + iii/1000 + 0.02 - objrtx2(iii).visible = 0 - - Set objBallShadow(iii) = Eval("BallShadow" & iii) - objBallShadow(iii).material = "BallShadow" & iii - UpdateMaterial objBallShadow(iii).material,1,0,0,0,0,0,AmbientBSFactor,RGB(0,0,0),0,0,False,True,0,0,0,0 - objBallShadow(iii).Z = 1 + iii/1000 + 0.04 - objBallShadow(iii).visible = 0 - - BallShadowA(iii).Opacity = 100*AmbientBSFactor - BallShadowA(iii).visible = 0 - Next - - iii = 0 - - For Each Source in DynamicSources - DSSources(iii) = Array(Source.x, Source.y) -' If Instr(Source.name , "Left") > 0 Then DSGISide(iii) = 0 Else DSGISide(iii) = 1 'Adapted for TZ with GI left / GI right - iii = iii + 1 - Next - numberofsources = iii -end sub - -Sub DynamicBSUpdate - Dim falloff: falloff = 150 'Max distance to light sources, can be changed dynamically if you have a reason - Dim ShadowOpacity1, ShadowOpacity2 - Dim s, LSd, iii - Dim dist1, dist2, src1, src2 - Dim BOT: BOT=getballs 'Uncomment if you're deleting balls - Don't do it! #SaveTheBalls - - 'Hide shadow of deleted balls - For s = UBound(BOT) + 1 to tnob - 1 - objrtx1(s).visible = 0 - objrtx2(s).visible = 0 - objBallShadow(s).visible = 0 - BallShadowA(s).visible = 0 - Next - - If UBound(BOT) < lob Then Exit Sub 'No balls in play, exit - -'The Magic happens now - For s = lob to UBound(BOT) - -' *** Normal "ambient light" ball shadow - 'Layered from top to bottom. If you had an upper pf at for example 80 units and ramps even above that, your segments would be z>110; z<=110 And z>100; z<=100 And z>30; z<=30 And z>20; Else invisible - - If AmbientBallShadowOn = 1 Then 'Primitive shadow on playfield, flasher shadow in ramps - If BOT(s).Z > 30 Then 'The flasher follows the ball up ramps while the primitive is on the pf - If BOT(s).X < tablewidth/2 Then - objBallShadow(s).X = ((BOT(s).X) - (Ballsize/10) + ((BOT(s).X - (tablewidth/2))/(Ballsize/AmbientMovement))) + offsetX + 5 - Else - objBallShadow(s).X = ((BOT(s).X) + (Ballsize/10) + ((BOT(s).X - (tablewidth/2))/(Ballsize/AmbientMovement))) + offsetX - 5 - End If - objBallShadow(s).Y = BOT(s).Y + BallSize/10 + offsetY - objBallShadow(s).visible = 1 - - BallShadowA(s).X = BOT(s).X + offsetX - BallShadowA(s).Y = BOT(s).Y + BallSize/5 - BallShadowA(s).height=BOT(s).z - BallSize/4 'This is technically 1/4 of the ball "above" the ramp, but it keeps it from clipping the ramp - BallShadowA(s).visible = 1 - Elseif BOT(s).Z <= 30 And BOT(s).Z > 20 Then 'On pf, primitive only - objBallShadow(s).visible = 1 - If BOT(s).X < tablewidth/2 Then - objBallShadow(s).X = ((BOT(s).X) - (Ballsize/10) + ((BOT(s).X - (tablewidth/2))/(Ballsize/AmbientMovement))) + offsetX + 5 - Else - objBallShadow(s).X = ((BOT(s).X) + (Ballsize/10) + ((BOT(s).X - (tablewidth/2))/(Ballsize/AmbientMovement))) + offsetX - 5 - End If - objBallShadow(s).Y = BOT(s).Y + offsetY -' objBallShadow(s).Z = BOT(s).Z + s/1000 + 0.04 'Uncomment (and adjust If/Elseif height logic) if you want the primitive shadow on an upper/split pf - BallShadowA(s).visible = 0 - Else 'Under pf, no shadows - objBallShadow(s).visible = 0 - BallShadowA(s).visible = 0 - end if - - Elseif AmbientBallShadowOn = 2 Then 'Flasher shadow everywhere - If BOT(s).Z > 30 Then 'In a ramp - BallShadowA(s).X = BOT(s).X + offsetX - BallShadowA(s).Y = BOT(s).Y + BallSize/5 - BallShadowA(s).height=BOT(s).z - BallSize/4 'This is technically 1/4 of the ball "above" the ramp, but it keeps it from clipping the ramp - BallShadowA(s).visible = 1 - Elseif BOT(s).Z <= 30 And BOT(s).Z > 20 Then 'On pf - BallShadowA(s).visible = 1 - If BOT(s).X < tablewidth/2 Then - BallShadowA(s).X = ((BOT(s).X) - (Ballsize/10) + ((BOT(s).X - (tablewidth/2))/(Ballsize/AmbientMovement))) + offsetX + 5 - Else - BallShadowA(s).X = ((BOT(s).X) + (Ballsize/10) + ((BOT(s).X - (tablewidth/2))/(Ballsize/AmbientMovement))) + offsetX - 5 - End If - BallShadowA(s).Y = BOT(s).Y + Ballsize/10 + offsetY - BallShadowA(s).height=BOT(s).z - BallSize/2 + 5 - Else 'Under pf - BallShadowA(s).visible = 0 - End If - End If - -' *** Dynamic shadows - If DynamicBallShadowsOn Then - If BOT(s).Z < 30 And BOT(s).X < 850 Then 'Parameters for where the shadows can show, here they are not visible above the table (no upper pf) or in the plunger lane - dist1 = falloff: - dist2 = falloff - For iii = 0 to numberofsources - 1 ' Search the 2 nearest influencing lights - LSd = Distance(BOT(s).x, BOT(s).y, DSSources(iii)(0), DSSources(iii)(1)) 'Calculating the Linear distance to the Source - If LSd < falloff And gilvl > 0 Then -' If LSd < dist2 And ((DSGISide(iii) = 0 And Lampz.State(100)>0) Or (DSGISide(iii) = 1 And Lampz.State(104)>0)) Then 'Adapted for TZ with GI left / GI right - dist2 = dist1 - dist1 = LSd - src2 = src1 - src1 = iii - End If - Next - ShadowOpacity1 = 0 - If dist1 < falloff Then - objrtx1(s).visible = 1 : objrtx1(s).X = BOT(s).X : objrtx1(s).Y = BOT(s).Y - 'objrtx1(s).Z = BOT(s).Z - 25 + s/1000 + 0.01 'Uncomment if you want to add shadows to an upper/lower pf - objrtx1(s).rotz = AnglePP(DSSources(src1)(0), DSSources(src1)(1), BOT(s).X, BOT(s).Y) + 90 - ShadowOpacity1 = 1 - dist1 / falloff - objrtx1(s).size_y = Wideness * ShadowOpacity1 + Thinness - UpdateMaterial objrtx1(s).material,1,0,0,0,0,0,ShadowOpacity1*DynamicBSFactor^3,RGB(0,0,0),0,0,False,True,0,0,0,0 - Else - objrtx1(s).visible = 0 - End If - ShadowOpacity2 = 0 - If dist2 < falloff Then - objrtx2(s).visible = 1 : objrtx2(s).X = BOT(s).X : objrtx2(s).Y = BOT(s).Y + offsetY - 'objrtx2(s).Z = BOT(s).Z - 25 + s/1000 + 0.02 'Uncomment if you want to add shadows to an upper/lower pf - objrtx2(s).rotz = AnglePP(DSSources(src2)(0), DSSources(src2)(1), BOT(s).X, BOT(s).Y) + 90 - ShadowOpacity2 = 1 - dist2 / falloff - objrtx2(s).size_y = Wideness * ShadowOpacity2 + Thinness - UpdateMaterial objrtx2(s).material,1,0,0,0,0,0,ShadowOpacity2*DynamicBSFactor^3,RGB(0,0,0),0,0,False,True,0,0,0,0 - Else - objrtx2(s).visible = 0 - End If - If AmbientBallShadowOn = 1 Then - 'Fades the ambient shadow (primitive only) when it's close to a light - UpdateMaterial objBallShadow(s).material,1,0,0,0,0,0,AmbientBSFactor*(1 - max(ShadowOpacity1, ShadowOpacity2)),RGB(0,0,0),0,0,False,True,0,0,0,0 - Else - BallShadowA(s).Opacity = 100 * AmbientBSFactor * (1 - max(ShadowOpacity1, ShadowOpacity2)) - End If - Else 'Hide dynamic shadows everywhere else, just in case - objrtx2(s).visible = 0 : objrtx1(s).visible = 0 - End If - End If - Next -End Sub -'**************************************************************** -'**** END VPW DYNAMIC BALL SHADOWS by Iakki, Apophis, and Wylte -'**************************************************************** - -'****************************************************** -' VPW TargetBouncer for targets and posts by Iaakki, Wrd1972, Apophis -'****************************************************** - -Const TargetBouncerEnabled = 1 '0 = normal standup targets, 1 = bouncy targets -Const TargetBouncerFactor = 0.7 'Level of bounces. Recommmended value of 0.7 - -sub TargetBouncer(aBall,defvalue) - dim zMultiplier, vel, vratio - if TargetBouncerEnabled = 1 and aball.z < 30 then - 'debug.print "velx: " & aball.velx & " vely: " & aball.vely & " velz: " & aball.velz - vel = BallSpeed(aBall) - if aBall.velx = 0 then vratio = 1 else vratio = aBall.vely/aBall.velx - Select Case Int(Rnd * 6) + 1 - Case 1: zMultiplier = 0.2*defvalue - Case 2: zMultiplier = 0.25*defvalue - Case 3: zMultiplier = 0.3*defvalue - Case 4: zMultiplier = 0.4*defvalue - Case 5: zMultiplier = 0.45*defvalue - Case 6: zMultiplier = 0.5*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 - -' Add targets or posts to the TargetBounce collection if you want to activate the targetbouncer code from them -Sub TargetBounce_Hit(idx) - TargetBouncer activeball, 1 -End Sub - - - - -'****************************************************** -'**** FLIPPER CORRECTIONS by nFozzy -'****************************************************** -' -' There are several steps for taking advantage of nFozzy's flipper solution. At a high level we’ll need the following: -' 1. flippers with specific physics settings -' 2. custom triggers for each flipper (TriggerLF, TriggerRF) -' 3. an object or point to tell the script where the tip of the flipper is at rest (EndPointLp, EndPointRp) -' 4. and, special scripting -' -' A common mistake is incorrect flipper length. A 3-inch flipper with rubbers will be about 3.125 inches long. -' This translates to about 147 vp units. Therefore, the flipper start radius + the flipper length + the flipper end -' radius should equal approximately 147 vp units. Another common mistake is is that sometimes the right flipper -' angle was set with a large postive value (like 238 or something). It should be using negative value (like -122). -' -' The following settings are a solid starting point for various eras of pinballs. -' | | EM's | late 70's to mid 80's | mid 80's to early 90's | mid 90's and later | -' | ------------------ | -------------- | --------------------- | ---------------------- | ------------------ | -' | Mass | 1 | 1 | 1 | 1 | -' | Strength | 500-1000 (750) | 1400-1600 (1500) | 2000-2600 | 3200-3300 (3250) | -' | Elasticity | 0.88 | 0.88 | 0.88 | 0.88 | -' | Elasticity Falloff | 0.15 | 0.15 | 0.15 | 0.15 | -' | Fricition | 0.8-0.9 | 0.9 | 0.9 | 0.9 | -' | Return Strength | 0.11 | 0.09 | 0.07 | 0.055 | -' | Coil Ramp Up | 2.5 | 2.5 | 2.5 | 2.5 | -' | Scatter Angle | 0 | 0 | 0 | 0 | -' | EOS Torque | 0.3 | 0.3 | 0.275 | 0.275 | -' | EOS Torque Angle | 4 | 4 | 6 | 6 | -' - - -'****************************************************** -' Flippers Polarity (Select appropriate sub based on era) -'****************************************************** - -dim LF : Set LF = New FlipperPolarity -dim RF : Set RF = New FlipperPolarity - -InitPolarity - - - -'******************************************* -' Late 80's early 90'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 = 60 - Next - - AddPt "Polarity", 0, 0, 0 - AddPt "Polarity", 1, 0.05, -5 - AddPt "Polarity", 2, 0.4, -5 - AddPt "Polarity", 3, 0.6, -4.5 - AddPt "Polarity", 4, 0.65, -4.0 - AddPt "Polarity", 5, 0.7, -3.5 - AddPt "Polarity", 6, 0.75, -3.0 - AddPt "Polarity", 7, 0.8, -2.5 - AddPt "Polarity", 8, 0.85, -2.0 - AddPt "Polarity", 9, 0.9,-1.5 - AddPt "Polarity", 10, 0.95, -1.0 - AddPt "Polarity", 11, 1, -0.5 - AddPt "Polarity", 12, 1.1, 0 - AddPt "Polarity", 13, 1.3, 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 - - - -' -''******************************************* -'' Early 90's and after -' -'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 = 60 -' Next -' -' AddPt "Polarity", 0, 0, 0 -' AddPt "Polarity", 1, 0.05, -5.5 -' AddPt "Polarity", 2, 0.4, -5.5 -' AddPt "Polarity", 3, 0.6, -5.0 -' AddPt "Polarity", 4, 0.65, -4.5 -' AddPt "Polarity", 5, 0.7, -4.0 -' AddPt "Polarity", 6, 0.75, -3.5 -' AddPt "Polarity", 7, 0.8, -3.0 -' AddPt "Polarity", 8, 0.85, -2.5 -' AddPt "Polarity", 9, 0.9,-2.0 -' AddPt "Polarity", 10, 0.95, -1.5 -' AddPt "Polarity", 11, 1, -1.0 -' AddPt "Polarity", 12, 1.05, -0.5 -' AddPt "Polarity", 13, 1.1, 0 -' AddPt "Polarity", 14, 1.3, 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 - - -' Flipper trigger hit subs - -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 -'****************************************************** - -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) - End If - End If - RemoveBall aBall - End Sub -End Class - - - - - -'****************************************************** -' SLINGSHOT CORRECTION FUNCTIONS -'****************************************************** -' To add these slingshot corrections: -' - On the table, add the endpoint primitives that define the two ends of the Slingshot -' - Initialize the SlingshotCorrection objects in InitSlingCorrection -' - Call the .VelocityCorrect methods from the respective _Slingshot event sub - - -dim LS : Set LS = New SlingshotCorrection -dim RS : Set RS = New SlingshotCorrection - -InitSlingCorrection - -Sub InitSlingCorrection - - LS.Object = LeftSlingshot - LS.EndPoint1 = EndPoint1LS - LS.EndPoint2 = EndPoint2LS - - RS.Object = RightSlingshot - RS.EndPoint1 = EndPoint1RS - RS.EndPoint2 = EndPoint2RS - - 'Slingshot angle corrections (pt, BallPos in %, Angle in deg) - ' These values are best guesses. Retune them if needed based on specific table research. - AddSlingsPt 0, 0.00, -4 - AddSlingsPt 1, 0.45, -7 - AddSlingsPt 2, 0.48, 0 - AddSlingsPt 3, 0.52, 0 - AddSlingsPt 4, 0.55, 7 - AddSlingsPt 5, 1.00, 4 - -End Sub - - -Sub AddSlingsPt(idx, aX, aY) 'debugger wrapper for adjusting flipper script in-game - dim a : a = Array(LS, RS) - dim x : for each x in a - x.addpoint idx, aX, aY - Next -End Sub - -'' The following sub are needed, however they may exist somewhere else in the script. Uncomment below if needed -'Dim PI: PI = 4*Atn(1) -'Function dSin(degrees) -' dsin = sin(degrees * Pi/180) -'End Function -'Function dCos(degrees) -' dcos = cos(degrees * Pi/180) -'End Function -' -Function RotPoint(x,y,angle) - dim rx, ry - rx = x*dCos(angle) - y*dSin(angle) - ry = x*dSin(angle) + y*dCos(angle) - RotPoint = Array(rx,ry) -End Function - -Class SlingshotCorrection - Public DebugOn, Enabled - private Slingshot, SlingX1, SlingX2, SlingY1, SlingY2 - - Public ModIn, ModOut - Private Sub Class_Initialize : redim ModIn(0) : redim Modout(0): Enabled = True : End Sub - - Public Property let Object(aInput) : Set Slingshot = aInput : End Property - Public Property Let EndPoint1(aInput) : SlingX1 = aInput.x: SlingY1 = aInput.y: End Property - Public Property Let EndPoint2(aInput) : SlingX2 = aInput.x: SlingY2 = aInput.y: End Property - - 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 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 - - - Public Sub VelocityCorrect(aBall) - dim BallPos, XL, XR, YL, YR - - 'Assign right and left end points - If SlingX1 < SlingX2 Then - XL = SlingX1 : YL = SlingY1 : XR = SlingX2 : YR = SlingY2 - Else - XL = SlingX2 : YL = SlingY2 : XR = SlingX1 : YR = SlingY1 - End If - - 'Find BallPos = % on Slingshot - If Not IsEmpty(aBall.id) Then - If ABS(XR-XL) > ABS(YR-YL) Then - BallPos = PSlope(aBall.x, XL, 0, XR, 1) - Else - BallPos = PSlope(aBall.y, YL, 0, YR, 1) - End If - If BallPos < 0 Then BallPos = 0 - If BallPos > 1 Then BallPos = 1 - End If - - 'Velocity angle correction - If not IsEmpty(ModIn(0) ) then - Dim Angle, RotVxVy - Angle = LinearEnvelope(BallPos, ModIn, ModOut) - 'debug.print " BallPos=" & BallPos &" Angle=" & Angle - 'debug.print " BEFORE: aBall.Velx=" & aBall.Velx &" aBall.Vely" & aBall.Vely - RotVxVy = RotPoint(aBall.Velx,aBall.Vely,Angle) - If Enabled then aBall.Velx = RotVxVy(0) - If Enabled then aBall.Vely = RotVxVy(1) - 'debug.print " AFTER: aBall.Velx=" & aBall.Velx &" aBall.Vely" & aBall.Vely - 'debug.print " " - End If - End Sub - -End Class - - - -'****************************************************** -' FLIPPER POLARITY. RUBBER DAMPENER, AND SLINGSHOT CORRECTION SUPPORTING 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 - - -' 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 - - -'****************************************************** -' 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 b', BOT - BOT = GetBalls - - If Flipper1.currentangle = Endangle1 and EOSNudge1 <> 1 Then - EOSNudge1 = 1 - 'debug.print Flipper1.currentangle &" = "& Endangle1 &"--"& Flipper2.currentangle &" = "& EndAngle2 - If Flipper2.currentangle = EndAngle2 Then - 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 - BOT(b).velx = BOT(b).velx / 1.3 - BOT(b).vely = BOT(b).vely - 0.5 - end If - Next - End If - Else - If Abs(Flipper1.currentangle) > Abs(EndAngle1) + 30 then EOSNudge1 = 0 - End If -End Sub - -'***************** -' Maths -'***************** -Dim PI: PI = 4*Atn(1) - -Function dSin(degrees) - dsin = sin(degrees * Pi/180) -End Function - -Function dCos(degrees) - dcos = cos(degrees * Pi/180) -End Function - -Function Atn2(dy, dx) - 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 - -'************************************************* -' 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 - -Const FlipperCoilRampupMode = 0 '0 = fast, 1 = medium, 2 = slow (tap passes should work) - -LFState = 1 -RFState = 1 -EOST = leftflipper.eostorque -EOSA = leftflipper.eostorqueangle -Frampup = LeftFlipper.rampup -FElasticity = LeftFlipper.elasticity -FReturn = LeftFlipper.return -'Const EOSTnew = 1 'EM's to late 80's -Const EOSTnew = 0.8 '90's and later -Const EOSAnew = 1 -Const EOSRampup = 0 -Dim SOSRampup -Select Case FlipperCoilRampupMode - Case 0: - SOSRampup = 2.5 - Case 1: - SOSRampup = 6 - Case 2: - SOSRampup = 8.5 -End Select - -Const LiveCatch = 16 -Const LiveElasticity = 0.45 -Const SOSEM = 0.815 -'Const EOSReturn = 0.055 'EM's -'Const EOSReturn = 0.045 'late 70's to mid 80's -Const EOSReturn = 0.035 'mid 80's to early 90's -'Const EOSReturn = 0.025 'mid 90's and later - -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 b', BOT -' 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 = 114 '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.5 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 - - If LiveCatchBounce = 0 and ball.velx * Dir > 0 Then ball.velx = 0 - ball.vely = LiveCatchBounce * (32 / LiveCatch) ' Multiplier for inaccuracy bounce - ball.angmomx= 0 - ball.angmomy= 0 - ball.angmomz= 0 - Else - If Abs(Flipper.currentangle) <= Abs(Flipper.endangle) + 1 Then FlippersD.Dampenf Activeball, parm - End If -End Sub - - -'****************************************************** -'**** END FLIPPER CORRECTIONS -'****************************************************** - - - - - - - - -'****************************************************** -'**** 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, 1.1 'point# (keep sequential), ballspeed, CoR (elasticity) -RubbersD.addpoint 1, 3.77, 0.97 -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 - -'######################### Add new FlippersD Profile -'######################### Adjust these values to increase or lessen the elasticity - -dim FlippersD : Set FlippersD = new Dampener -FlippersD.name = "Flippers" -FlippersD.debugOn = False -FlippersD.Print = False -FlippersD.addpoint 0, 0, 1.1 -FlippersD.addpoint 1, 3.77, 0.99 -FlippersD.addpoint 2, 6, 0.99 - -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)+0.0001) - 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 Dampenf(aBall, parm) 'Rubberizer is handle here - dim RealCOR, DesiredCOR, str, coef - DesiredCor = LinearEnvelope(cor.ballvel(aBall.id), ModIn, ModOut ) - RealCOR = BallSpeed(aBall) / (cor.ballvel(aBall.id)+0.0001) - coef = desiredcor / realcor - If abs(aball.velx) < 2 and aball.vely < 0 and aball.vely > -3.75 then - aBall.velx = aBall.velx * coef : aBall.vely = aBall.vely * coef - End If - 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 - - - - -'****************************************************** -'**** END PHYSICS DAMPENERS -'****************************************************** - - - -'****************************************************** -' STAND-UP TARGET INITIALIZATION -'****************************************************** - -'Define a variable for each stand-up target -Dim ST20, ST21, ST22, ST23, ST6, ST7, ST8, ST9, ST11 ,ST17 ,ST18, ST25 - -'Set array with stand-up target objects -' -'StandupTargetvar = Array(primary, prim, swtich) -' primary: vp target to determine target hit -' prim: primitive target used for visuals and animation -' IMPORTANT!!! -' transy must be used to offset the target animation -' switch: ROM switch number -' animate: Arrary slot for handling the animation instrucitons, set to 0 -' -'You will also need to add a secondary hit object for each stand up (name sw11o, sw12o, and sw13o on the example Table1) -'these are inclined primitives to simulate hitting a bent target and should provide so z velocity on high speed impacts - -ST20 = Array(sw20, psw20,20, 0) -ST21 = Array(sw21, psw21,21, 0) -ST22 = Array(sw22, psw22,22, 0) -ST23 = Array(sw23, psw23,23, 0) -ST6 = Array(sw6, psw6,6, 0) -ST7 = Array(sw7, psw7,7, 0) -ST8 = Array(sw8, psw8,8, 0) -ST9 = Array(sw9, psw9,9, 0) -ST11 = Array(sw11, psw11,11, 0) -ST17 = Array(sw17, psw17,17, 0) -ST18 = Array(sw18, psw18,18, 0) -ST25 = Array(sw25, psw25,25, 0) - -'Add all the Stand-up Target Arrays to Stand-up Target Animation Array -' STAnimationArray = Array(ST1, ST2, ....) -Dim STArray -STArray = Array(ST20, ST21, ST22, ST23, ST6, ST7, ST8, ST9, ST11, ST17 ,ST18, ST25) - -'Configure the behavior of Stand-up Targets -Const STAnimStep = 1.5 'vpunits per animation step (control return to Start) -Const STMaxOffset = 9 'max vp units target moves when hit - -Const STMass = 0.2 'Mass of the Stand-up Target (between 0 and 1), higher values provide more resistance - - - -'****************************************************** -' STAND-UP TARGETS FUNCTIONS -'****************************************************** - -Sub STHit(switch) - Dim i - i = STArrayID(switch) - - PlayTargetSound - STArray(i)(3) = STCheckHit(Activeball,STArray(i)(0)) - - If STArray(i)(3) <> 0 Then - DTBallPhysics Activeball, STArray(i)(0).orientation, STMass - End If - DoSTAnim -End Sub - -Function STArrayID(switch) - Dim i - For i = 0 to uBound(STArray) - If STArray(i)(2) = switch Then STArrayID = i:Exit Function - Next -End Function - -'Check if target is hit on it's face -Function STCheckHit(aBall, target) - dim bangle, bangleafter, rangle, rangle2, perpvel, perpvelafter, paravel, paravelafter - rangle = (target.orientation - 90) * 3.1416 / 180 - bangle = atn2(cor.ballvely(aball.id),cor.ballvelx(aball.id)) - bangleafter = Atn2(aBall.vely,aball.velx) - - perpvel = cor.BallVel(aball.id) * cos(bangle-rangle) - paravel = cor.BallVel(aball.id) * sin(bangle-rangle) - - perpvelafter = BallSpeed(aBall) * cos(bangleafter - rangle) - paravelafter = BallSpeed(aBall) * sin(bangleafter - rangle) - - If perpvel > 0 and perpvelafter <= 0 Then - STCheckHit = 1 - ElseIf perpvel > 0 and ((paravel > 0 and paravelafter > 0) or (paravel < 0 and paravelafter < 0)) Then - STCheckHit = 1 - Else - STCheckHit = 0 - End If -End Function - -Sub DoSTAnim() - Dim i - For i=0 to Ubound(STArray) - STArray(i)(3) = STAnimate(STArray(i)(0),STArray(i)(1),STArray(i)(2),STArray(i)(3)) - Next -End Sub - -Function STAnimate(primary, prim, switch, animate) - Dim animtime - - STAnimate = animate - - if animate = 0 Then - primary.uservalue = 0 - STAnimate = 0 - Exit Function - Elseif primary.uservalue = 0 then - primary.uservalue = gametime - end if - - animtime = gametime - primary.uservalue - - If animate = 1 Then - primary.collidable = 0 - prim.transy = -STMaxOffset - if UsingROM then - vpmTimer.PulseSw switch - else - STAction switch - end if - STAnimate = 2 - Exit Function - elseif animate = 2 Then - prim.transy = prim.transy + STAnimStep - If prim.transy >= 0 Then - prim.transy = 0 - primary.collidable = 1 - STAnimate = 0 - Exit Function - Else - STAnimate = 2 - End If - End If -End Function - -Sub STAction(Switch) - Select Case Switch - Case 11: - Addscore 1000 - Flash1 True 'Demo of the flasher - vpmTimer.AddTimer 150,"Flash1 False'" 'Disable the flash after short time, just like a ROM would do - Case 12: - Addscore 1000 - Flash2 True 'Demo of the flasher - vpmTimer.AddTimer 150,"Flash2 False'" 'Disable the flash after short time, just like a ROM would do - Case 13: - Addscore 1000 - Flash3 True 'Demo of the flasher - vpmTimer.AddTimer 150,"Flash3 False'" 'Disable the flash after short time, just like a ROM would do - End Select -End Sub - - - -sub DTBallPhysics(aBall, angle, mass) - dim rangle,bangle,calc1, calc2, calc3 - rangle = (angle - 90) * 3.1416 / 180 - bangle = atn2(cor.ballvely(aball.id),cor.ballvelx(aball.id)) - - calc1 = cor.BallVel(aball.id) * cos(bangle - rangle) * (aball.mass - mass) / (aball.mass + mass) - calc2 = cor.BallVel(aball.id) * sin(bangle - rangle) * cos(rangle + 4*Atn(1)/2) - calc3 = cor.BallVel(aball.id) * sin(bangle - rangle) * sin(rangle + 4*Atn(1)/2) - - aBall.velx = calc1 * cos(rangle) + calc2 - aBall.vely = calc1 * sin(rangle) + calc3 -End Sub - - - - -'****************************************************** -' END STAND-UP TARGETS -'****************************************************** - - - - - -'****************************************************** -'**** BALL ROLLING AND DROP SOUNDS -'****************************************************** -' -' Be sure to call RollingUpdate in a timer with a 10ms interval see the GameTimer_Timer() sub - -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 RollingUpdate() - Dim b', BOT - BOT = GetBalls - - ' stop the sound of deleted balls - For b = UBound(BOT) + 1 to tnob - ' Comment the next line if you are not implementing Dyanmic Ball Shadows - If AmbientBallShadowOn = 0 Then BallShadowA(b).visible = 0 - 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)) * BallRollVolume * 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 - - ' "Static" Ball Shadows - ' Comment the next If block, if you are not implementing the Dyanmic Ball Shadows - If AmbientBallShadowOn = 0 Then - If BOT(b).Z > 30 Then - BallShadowA(b).height=BOT(b).z - BallSize/4 'This is technically 1/4 of the ball "above" the ramp, but it keeps it from clipping the ramp - Else - BallShadowA(b).height=BOT(b).z - BallSize/2 + 5 - End If - BallShadowA(b).Y = BOT(b).Y + Ballsize/5 + offsetY - BallShadowA(b).X = BOT(b).X + offsetX - BallShadowA(b).visible = 1 - End If - Next -End Sub - - -'****************************************************** -'**** END BALL ROLLING AND DROP SOUNDS -'****************************************************** - - - - -'****************************************************** -'**** RAMP ROLLING SFX -'****************************************************** - -'Ball tracking ramp SFX 1.0 -' Reqirements: -' * Import A Sound File for each ball on the table for plastic ramps. Call It RampLoop ex: RampLoop1, RampLoop2, ... -' * Import a Sound File for each ball on the table for wire ramps. Call it WireLoop ex: WireLoop1, WireLoop2, ... -' * Create a Timer called RampRoll, that is enabled, with a interval of 100 -' * Set RampBAlls and RampType variable to Total Number of Balls -' Usage: -' * Setup hit events and call WireRampOn True or WireRampOn False (True = Plastic ramp, False = Wire Ramp) -' * To stop tracking ball -' * call WireRampOff -' * Otherwise, the ball will auto remove if it's below 30 vp units -' - -dim RampMinLoops : RampMinLoops = 4 - -' RampBalls -' Setup: Set the array length of x in RampBalls(x,2) Total Number of Balls on table + 1: if tnob = 5, then RammBalls(6,2) -' Description: -dim RampBalls(6,2) -'x,0 = ball x,1 = ID, 2 = Protection against ending early (minimum amount of updates) -'0,0 is boolean on/off, 0,1 unused for now -RampBalls(0,0) = False - -' RampType -' Setup: Set this array to the number Total number of balls that can be tracked at one time + 1. 5 ball multiball then set value to 6 -' Description: Array type indexed on BallId and a values used to deterimine what type of ramp the ball is on: False = Wire Ramp, True = Plastic Ramp -dim RampType(6) - -Sub WireRampOn(input) : Waddball ActiveBall, input : RampRollUpdate: End Sub -Sub WireRampOff() : WRemoveBall ActiveBall.ID : End Sub - - -' WaddBall (Active Ball, Boolean) -' Description: This subroutine is called from WireRampOn to Add Balls to the RampBalls Array -Sub Waddball(input, RampInput) 'Add ball - ' This will loop through the RampBalls array checking each element of the array x, position 1 - ' To see if the the ball was already added to the array. - ' If the ball is found then exit the subroutine - dim x : for x = 1 to uBound(RampBalls) 'Check, don't add balls twice - if RampBalls(x, 1) = input.id then - if Not IsEmpty(RampBalls(x,1) ) then Exit Sub 'Frustating issue with BallId 0. Empty variable = 0 - End If - Next - - ' This will itterate through the RampBalls Array. - ' The first time it comes to a element in the array where the Ball Id (Slot 1) is empty. It will add the current ball to the array - ' The RampBalls assigns the ActiveBall to element x,0 and ball id of ActiveBall to 0,1 - ' The RampType(BallId) is set to RampInput - ' RampBalls in 0,0 is set to True, this will enable the timer and the timer is also turned on - For x = 1 to uBound(RampBalls) - if IsEmpty(RampBalls(x, 1)) then - Set RampBalls(x, 0) = input - RampBalls(x, 1) = input.ID - RampType(x) = RampInput - RampBalls(x, 2) = 0 - 'exit For - RampBalls(0,0) = True - RampRoll.Enabled = 1 'Turn on timer - 'RampRoll.Interval = RampRoll.Interval 'reset timer - exit Sub - End If - if x = uBound(RampBalls) then 'debug - Debug.print "WireRampOn error, ball queue is full: " & vbnewline & _ - RampBalls(0, 0) & vbnewline & _ - Typename(RampBalls(1, 0)) & " ID:" & RampBalls(1, 1) & "type:" & RampType(1) & vbnewline & _ - Typename(RampBalls(2, 0)) & " ID:" & RampBalls(2, 1) & "type:" & RampType(2) & vbnewline & _ - Typename(RampBalls(3, 0)) & " ID:" & RampBalls(3, 1) & "type:" & RampType(3) & vbnewline & _ - Typename(RampBalls(4, 0)) & " ID:" & RampBalls(4, 1) & "type:" & RampType(4) & vbnewline & _ - Typename(RampBalls(5, 0)) & " ID:" & RampBalls(5, 1) & "type:" & RampType(5) & vbnewline & _ - " " - End If - next -End Sub - -' WRemoveBall (BallId) -' Description: This subroutine is called from the RampRollUpdate subroutine -' and is used to remove and stop the ball rolling sounds -Sub WRemoveBall(ID) 'Remove ball - 'Debug.Print "In WRemoveBall() + Remove ball from loop array" - dim ballcount : ballcount = 0 - dim x : for x = 1 to Ubound(RampBalls) - if ID = RampBalls(x, 1) then 'remove ball - Set RampBalls(x, 0) = Nothing - RampBalls(x, 1) = Empty - RampType(x) = Empty - StopSound("RampLoop" & x) - StopSound("wireloop" & x) - end If - 'if RampBalls(x,1) = Not IsEmpty(Rampballs(x,1) then ballcount = ballcount + 1 - if not IsEmpty(Rampballs(x,1)) then ballcount = ballcount + 1 - next - if BallCount = 0 then RampBalls(0,0) = False 'if no balls in queue, disable timer update -End Sub - -Sub RampRoll_Timer():RampRollUpdate:End Sub - -Sub RampRollUpdate() 'Timer update - dim x : for x = 1 to uBound(RampBalls) - if Not IsEmpty(RampBalls(x,1) ) then - if BallVel(RampBalls(x,0) ) > 1 then ' if ball is moving, play rolling sound - If RampType(x) then - PlaySound("RampLoop" & x), -1, VolPlayfieldRoll(RampBalls(x,0)) * RampRollVolume * VolumeDial, AudioPan(RampBalls(x,0)), 0, BallPitchV(RampBalls(x,0)), 1, 0, AudioFade(RampBalls(x,0)) - StopSound("wireloop" & x) - Else - StopSound("RampLoop" & x) - PlaySound("wireloop" & x), -1, VolPlayfieldRoll(RampBalls(x,0)) * RampRollVolume * VolumeDial, AudioPan(RampBalls(x,0)), 0, BallPitch(RampBalls(x,0)), 1, 0, AudioFade(RampBalls(x,0)) - End If - RampBalls(x, 2) = RampBalls(x, 2) + 1 - Else - StopSound("RampLoop" & x) - StopSound("wireloop" & x) - end if - if RampBalls(x,0).Z < 30 and RampBalls(x, 2) > RampMinLoops then 'if ball is on the PF, remove it - StopSound("RampLoop" & x) - StopSound("wireloop" & x) - Wremoveball RampBalls(x,1) - End If - Else - StopSound("RampLoop" & x) - StopSound("wireloop" & x) - end if - next - if not RampBalls(0,0) then RampRoll.enabled = 0 - -End Sub - -' This can be used to debug the Ramp Roll time. You need to enable the tbWR timer on the TextBox -Sub tbWR_Timer() 'debug textbox - me.text = "on? " & RampBalls(0, 0) & " timer: " & RampRoll.Enabled & vbnewline & _ - "1 " & Typename(RampBalls(1, 0)) & " ID:" & RampBalls(1, 1) & " type:" & RampType(1) & " Loops:" & RampBalls(1, 2) & vbnewline & _ - "2 " & Typename(RampBalls(2, 0)) & " ID:" & RampBalls(2, 1) & " type:" & RampType(2) & " Loops:" & RampBalls(2, 2) & vbnewline & _ - "3 " & Typename(RampBalls(3, 0)) & " ID:" & RampBalls(3, 1) & " type:" & RampType(3) & " Loops:" & RampBalls(3, 2) & vbnewline & _ - "4 " & Typename(RampBalls(4, 0)) & " ID:" & RampBalls(4, 1) & " type:" & RampType(4) & " Loops:" & RampBalls(4, 2) & vbnewline & _ - "5 " & Typename(RampBalls(5, 0)) & " ID:" & RampBalls(5, 1) & " type:" & RampType(5) & " Loops:" & RampBalls(5, 2) & vbnewline & _ - "6 " & Typename(RampBalls(6, 0)) & " ID:" & RampBalls(6, 1) & " type:" & RampType(6) & " Loops:" & RampBalls(6, 2) & vbnewline & _ - " " -End Sub - - -Function BallPitch(ball) ' Calculates the pitch of the sound based on the ball speed - BallPitch = pSlope(BallVel(ball), 1, -1000, 60, 10000) -End Function - -Function BallPitchV(ball) ' Calculates the pitch of the sound based on the ball speed Variation - BallPitchV = pSlope(BallVel(ball), 1, -4000, 60, 7000) -End Function - - - -'****************************************************** -'**** END RAMP ROLLING SFX -'****************************************************** - - - - - -'****************************************************** -'**** FLEEP 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 the TOM table - -' Many of the sounds in this package can be added by creating collections and adding the appropriate objects to those collections. -' Create the following new collections: -' Metals (all metal objects, metal walls, metal posts, metal wire guides) -' Apron (the apron walls and plunger wall) -' Walls (all wood or plastic walls) -' Rollovers (wire rollover triggers, star triggers, or button triggers) -' Targets (standup or drop targets, these are hit sounds only ... you will want to add separate dropping sounds for drop targets) -' Gates (plate gates) -' GatesWire (wire gates) -' Rubbers (all rubbers including posts, sleeves, pegs, and bands) -' When creating the collections, make sure "Fire events for this collection" is checked. -' You'll also need to make sure "Has Hit Event" is checked for each object placed in these collections (not necessary for gates and triggers). -' Once the collections and objects are added, the save, close, and restart VPX. -' -' Many places in the script need to be modified to include the correct sound effect subroutine calls. The tutorial videos linked below demonstrate -' how to make these updates. But in summary the following needs to be updated: -' - Nudging, plunger, coin-in, start button sounds will be added to the keydown and keyup subs. -' - Flipper sounds in the flipper solenoid subs. Flipper collision sounds in the flipper collide subs. -' - Bumpers, slingshots, drain, ball release, knocker, spinner, and saucers in their respective subs -' - Ball rolling sounds sub -' -' Tutorial vides by Apophis -' Part 1: https://youtu.be/PbE2kNiam3g -' Part 2: https://youtu.be/B5cm1Y8wQsk -' Part 3: https://youtu.be/eLhWyuYOyGg - - -'/////////////////////////////// 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] -SpinnerSoundLevel = 0.5 '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 -'****************************************************** - -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 > 7000 Then - tmp = 7000 - elseif tmp < -7000 Then - tmp = -7000 - end if - - 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 > 7000 Then - tmp = 7000 - elseif tmp < -7000 Then - tmp = -7000 - end if - - 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, sw1 -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 SoundFX("Bumpers_Middle_" & Int(Rnd*5)+1,DOFContactors), Vol(ActiveBall) * BumperSoundFactor, Bump -End Sub - -Sub RandomSoundBumperBottom(Bump) - PlaySoundAtLevelStatic SoundFX("Bumpers_Bottom_" & Int(Rnd*5)+1,DOFContactors), Vol(ActiveBall) * BumperSoundFactor, Bump -End Sub - -'///////////////////////////// SPINNER SOUNDS //////////////////////////// -Sub SoundSpinner(spinnerswitch) - PlaySoundAtLevelStatic ("Spinner"), SpinnerSoundLevel, spinnerswitch -End Sub - - -'///////////////////////////// FLIPPER BATS SOUND SUBROUTINES //////////////////////////// -'///////////////////////////// FLIPPER BATS SOLENOID ATTACK SOUND //////////////////////////// -Sub SoundFlipperUpAttackLeft(flipper) - FlipperUpAttackLeftSoundLevel = RndNum(FlipperUpAttackMinimumSoundLevel, FlipperUpAttackMaximumSoundLevel) - PlaySoundAtLevelStatic SoundFX("Flipper_Attack-L01",DOFFlippers), FlipperUpAttackLeftSoundLevel, flipper -End Sub - -Sub SoundFlipperUpAttackRight(flipper) - FlipperUpAttackRightSoundLevel = RndNum(FlipperUpAttackMinimumSoundLevel, FlipperUpAttackMaximumSoundLevel) - PlaySoundAtLevelStatic SoundFX("Flipper_Attack-R01",DOFFlippers), 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) - RandomSoundWall() -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 - - -'/////////////////////////// DROP TARGET HIT SOUNDS /////////////////////////// - -Sub RandomSoundDropTargetReset(obj) - PlaySoundAtLevelStatic SoundFX("Drop_Target_Reset_" & Int(Rnd*6)+1,DOFContactors), 1, obj -End Sub - -Sub SoundDropTargetDrop(obj) - PlaySoundAtLevelStatic ("Drop_Target_Down_" & Int(Rnd*6)+1), 200, obj -End Sub - -'///////////////////////////// GI AND FLASHER RELAYS //////////////////////////// - -Const RelayFlashSoundLevel = 0.315 'volume level; range [0, 1]; -Const RelayGISoundLevel = 1.05 'volume level; range [0, 1]; - -Sub Sound_GI_Relay(toggle, obj) - Select Case toggle - Case 1 - PlaySoundAtLevelStatic ("Relay_GI_On"), 0.025*RelayGISoundLevel, obj - Case 0 - PlaySoundAtLevelStatic ("Relay_GI_Off"), 0.025*RelayGISoundLevel, obj - End Select -End Sub - -Sub Sound_Flash_Relay(toggle, obj) - Select Case toggle - Case 1 - PlaySoundAtLevelStatic ("Relay_Flash_On"), 0.025*RelayFlashSoundLevel, obj - Case 0 - PlaySoundAtLevelStatic ("Relay_Flash_Off"), 0.025*RelayFlashSoundLevel, obj - End Select -End Sub - -'///////////////////////////////////////////////////////////////// -' End Mechanical Sounds -'///////////////////////////////////////////////////////////////// - -'****************************************************** -'**** FLEEP MECHANICAL SOUNDS -'****************************************************** - - - - -'****************************************************** -'**** LAMPZ by nFozzy -'****************************************************** -' -' Lampz is a utility designed to manage and fade the lights and light-related objects on a table that is being driven by a ROM. -' To set up Lampz, one must populate the Lampz.MassAssign array with VPX Light objects, where the index of the MassAssign array -' corrisponds to the ROM index of the associated light. More that one Light object can be associated with a single MassAssign index (not shown in this example) -' Optionally, callbacks can be assigned for each index using the Lampz.Callback array. This is very useful for allowing 3D Insert primitives -' to be controlled by the ROM. Note, the aLvl parameter (i.e. the fading level that ranges between 0 and 1) is appended to the callback call. - -Dim NullFader : set NullFader = new NullFadingObject -Dim Lampz : Set Lampz = New LampFader -Dim FadingState(200) -InitLampsNF ' Setup lamp assignments -LampTimer.Interval = -1 -LampTimer.Enabled = 1 - -Sub LampTimer_Timer() - dim x, chglamp - if UsingROM then chglamp = Controller.ChangedLamps - If Not IsEmpty(chglamp) Then - For x = 0 To UBound(chglamp) 'nmbr = chglamp(x, 0), state = chglamp(x, 1) - Lampz.state(chglamp(x, 0)) = chglamp(x, 1) - FadingState(chgLamp(x, 0)) = chgLamp(x, 1) + 3 'fading step - next - End If - Lampz.Update2 'update (fading logic only) - UpdateLeds - UpdateTexts -End Sub - -Sub DisableLighting(pri, DLintensity, ByVal aLvl) 'cp's script DLintensity = disabled lighting intesity - if Lampz.UseFunction then aLvl = Lampz.FilterOut(aLvl) 'Callbacks don't get this filter automatically - pri.blenddisablelighting = aLvl * DLintensity -End Sub - -Sub SetModLamp(id, val) - Lampz.state(id) = val -End Sub - - -Sub InitLampsNF() - - 'Filtering (comment out to disable) - Lampz.Filter = "LampFilter" 'Puts all lamp intensityscale output (no callbacks) through this function before updating - - 'Adjust fading speeds (max level / full MS fading time). The Modulate property must be set to 1 / max level if lamp is modulated. - dim x : for x = 0 to 150 : Lampz.FadeSpeedUp(x) = 1/40 : Lampz.FadeSpeedDown(x) = 1/120 : Lampz.Modulate(x) = 1 : next - - - 'Lampz Assignments - ' In a ROM based table, the lamp ID is used to set the state of the Lampz objects - - 'MassAssign is an optional way to do assignments. It'll create arrays automatically / append objects to existing arrays - Lampz.MassAssign(1)= l1 - Lampz.MassAssign(2)= l2 - Lampz.MassAssign(3)= l3 - Lampz.MassAssign(4)= l4 - Lampz.MassAssign(5)= l5 - Lampz.MassAssign(6)= l6 - Lampz.MassAssign(7)= l7 - Lampz.MassAssign(8)= L8 - Lampz.MassAssign(9)= l9 - Lampz.MassAssign(10)= l10 - Lampz.MassAssign(11)= l11 - Lampz.MassAssign(12)= l12 - Lampz.MassAssign(13)= L13 - Lampz.MassAssign(13)= L13b - Lampz.MassAssign(14)= L14 - Lampz.MassAssign(14)= L14b - Lampz.MassAssign(15)= L15 - Lampz.MassAssign(15)= L15b - Lampz.MassAssign(16)= L16 - Lampz.MassAssign(17)= L17 - Lampz.MassAssign(19)= L19 - Lampz.MassAssign(20)= L20 - Lampz.MassAssign(21)= L21 - Lampz.MassAssign(22)= L22 - Lampz.MassAssign(23)= L23 - Lampz.MassAssign(24)= L24 - Lampz.MassAssign(25)= L25 - Lampz.MassAssign(25)= L25a - Lampz.MassAssign(26)= L26 - Lampz.MassAssign(26)= L26a - Lampz.MassAssign(27)= L27 - Lampz.MassAssign(27)= L27a - Lampz.MassAssign(28)= L28 - Lampz.MassAssign(29)= L29 - Lampz.MassAssign(30)= L30 - Lampz.MassAssign(31)= L31 - Lampz.MassAssign(32)= l32 - Lampz.MassAssign(33)= L33 - Lampz.MassAssign(34)= L34 - Lampz.MassAssign(35)= L35 - Lampz.MassAssign(36)= L36 - Lampz.MassAssign(37)= L37 - Lampz.MassAssign(38)= L38 - Lampz.MassAssign(39)= L39 - Lampz.MassAssign(40)= L40 - Lampz.MassAssign(41)= L41 - Lampz.MassAssign(41)= L41a - Lampz.MassAssign(42)= L42 - Lampz.MassAssign(42)= L42a - Lampz.MassAssign(43)= L43 - Lampz.MassAssign(43)= L43a - Lampz.MassAssign(44)= L44 - Lampz.MassAssign(44)= L44a - Lampz.MassAssign(45)= L45 - Lampz.MassAssign(45)= L45a - Lampz.MassAssign(46)= L46 - Lampz.MassAssign(46)= L46a - Lampz.MassAssign(47)= L47 - Lampz.MassAssign(47)= L47a - Lampz.MassAssign(48)= L48 - Lampz.MassAssign(49)= L49 - Lampz.MassAssign(50)= L50 - Lampz.MassAssign(51)= L51 - Lampz.MassAssign(52)= L52 - Lampz.MassAssign(53)= L53 - Lampz.MassAssign(55)= L55 - Lampz.MassAssign(56)= L56 - Lampz.MassAssign(73)= l73 - Lampz.MassAssign(74)= l74 - Lampz.MassAssign(75)= l75 - Lampz.MassAssign(76)= l76 - Lampz.MassAssign(80)= l80 - - - 'Turn off all lamps on startup - Lampz.Init 'This just turns state of any lamps to 1 - - 'Immediate update to turn on GI, turn off lamps - Lampz.Update - -End Sub - -Sub UpdateTexts() - 'backdrop lights - Textm 78, l78a, "OVER" - Text 78, l78, "GAME" - Text 80, l80, "TILT" -End Sub - -'Texts - -Sub Text(nr, object, message) - Select Case FadingState(nr) - Case 4:object.Text = message:FadingState(nr) = 0 - Case 3:object.Text = "":FadingState(nr) = 0 - End Select -End Sub - -Sub Textm(nr, object, message) - Select Case FadingState(nr) - Case 4:object.Text = message - Case 3:object.Text = "" - End Select -End Sub - -'==================== -'Class jungle nf -'==================== - -'No-op object instead of adding more conditionals to the main loop -'It also prevents errors if empty lamp numbers are called, and it's only one object -'should be g2g? - -Class NullFadingObject : Public Property Let IntensityScale(input) : : End Property : End Class - -'version 0.11 - Mass Assign, Changed modulate style -'version 0.12 - Update2 (single -1 timer update) update method for core.vbs -'Version 0.12a - Filter can now be accessed via 'FilterOut' -'Version 0.12b - Changed MassAssign from a sub to an indexed property (new syntax: lampfader.MassAssign(15) = Light1 ) -'Version 0.13 - No longer requires setlocale. Callback() can be assigned multiple times per index -' Note: if using multiple 'LampFader' objects, set the 'name' variable to avoid conflicts with callbacks -'Version 0.14 - Updated to support modulated signals - Niwak - -Class LampFader - Public FadeSpeedDown(150), FadeSpeedUp(150) - Private Lock(150), Loaded(150), OnOff(150) - Public UseFunction - Private cFilter - Public UseCallback(150), cCallback(150) - Public Lvl(150), Obj(150) - Private Mult(150) - Public FrameTime - Private InitFrame - Public Name - - Sub Class_Initialize() - InitFrame = 0 - dim x : for x = 0 to uBound(OnOff) 'Set up fade speeds - FadeSpeedDown(x) = 1/100 'fade speed down - FadeSpeedUp(x) = 1/80 'Fade speed up - UseFunction = False - lvl(x) = 0 - OnOff(x) = 0 - Lock(x) = True : Loaded(x) = False - Mult(x) = 1 - Next - Name = "LampFaderNF" 'NEEDS TO BE CHANGED IF THERE'S MULTIPLE OF THESE OBJECTS, OTHERWISE CALLBACKS WILL INTERFERE WITH EACH OTHER!! - for x = 0 to uBound(OnOff) 'clear out empty obj - if IsEmpty(obj(x) ) then Set Obj(x) = NullFader' : Loaded(x) = True - Next - End Sub - - Public Property Get Locked(idx) : Locked = Lock(idx) : End Property ''debug.print Lampz.Locked(100) 'debug - Public Property Get state(idx) : state = OnOff(idx) : end Property - Public Property Let Filter(String) : Set cFilter = GetRef(String) : UseFunction = True : End Property - Public Function FilterOut(aInput) : if UseFunction Then FilterOut = cFilter(aInput) Else FilterOut = aInput End If : End Function - 'Public Property Let Callback(idx, String) : cCallback(idx) = String : UseCallBack(idx) = True : End Property - Public Property Let Callback(idx, String) - UseCallBack(idx) = True - 'cCallback(idx) = String 'old execute method - 'New method: build wrapper subs using ExecuteGlobal, then call them - cCallback(idx) = cCallback(idx) & "___" & String 'multiple strings dilineated by 3x _ - - dim tmp : tmp = Split(cCallback(idx), "___") - - dim str, x : for x = 0 to uBound(tmp) 'build proc contents - 'If Not tmp(x)="" then str = str & " " & tmp(x) & " aLVL" & " '" & x & vbnewline 'more verbose - If Not tmp(x)="" then str = str & tmp(x) & " aLVL:" - Next - 'msgbox "Sub " & name & idx & "(aLvl):" & str & "End Sub" - dim out : out = "Sub " & name & idx & "(aLvl):" & str & "End Sub" - ExecuteGlobal Out - - End Property - - Public Property Let state(ByVal idx, input) 'Major update path - if TypeName(input) <> "Double" and typename(input) <> "Integer" and typename(input) <> "Long" then - If input Then - input = 1 - Else - input = 0 - End If - End If - if Input <> OnOff(idx) then 'discard redundant updates - OnOff(idx) = input - Lock(idx) = False - Loaded(idx) = False - End If - End Property - - 'Mass assign, Builds arrays where necessary - 'Sub MassAssign(aIdx, aInput) - Public Property Let MassAssign(aIdx, aInput) - If typename(obj(aIdx)) = "NullFadingObject" Then 'if empty, use Set - if IsArray(aInput) then - obj(aIdx) = aInput - Else - Set obj(aIdx) = aInput - end if - Else - Obj(aIdx) = AppendArray(obj(aIdx), aInput) - end if - end Property - - Sub SetLamp(aIdx, aOn) : state(aIdx) = aOn : End Sub 'Solenoid Handler - - Public Sub TurnOnStates() 'If obj contains any light objects, set their states to 1 (Fading is our job!) - dim debugstr - dim idx : for idx = 0 to uBound(obj) - if IsArray(obj(idx)) then - 'debugstr = debugstr & "array found at " & idx & "..." - dim x, tmp : tmp = obj(idx) 'set tmp to array in order to access it - for x = 0 to uBound(tmp) - if typename(tmp(x)) = "Light" then DisableState tmp(x)' : debugstr = debugstr & tmp(x).name & " state'd" & vbnewline - tmp(x).intensityscale = 0.001 ' this can prevent init stuttering - Next - Else - if typename(obj(idx)) = "Light" then DisableState obj(idx)' : debugstr = debugstr & obj(idx).name & " state'd (not array)" & vbnewline - obj(idx).intensityscale = 0.001 ' this can prevent init stuttering - end if - Next - ''debug.print debugstr - End Sub - Private Sub DisableState(ByRef aObj) : aObj.FadeSpeedUp = 1000 : aObj.State = 1 : End Sub 'turn state to 1 - - Public Sub Init() 'Just runs TurnOnStates right now - TurnOnStates - End Sub - - Public Property Let Modulate(aIdx, aCoef) : Mult(aIdx) = aCoef : Lock(aIdx) = False : Loaded(aIdx) = False: End Property - Public Property Get Modulate(aIdx) : Modulate = Mult(aIdx) : End Property - - Public Sub Update1() 'Handle all boolean numeric fading. If done fading, Lock(x) = True. Update on a '1' interval Timer! - dim x : for x = 0 to uBound(OnOff) - if not Lock(x) then 'and not Loaded(x) then - if OnOff(x) > 0 then 'Fade Up - Lvl(x) = Lvl(x) + FadeSpeedUp(x) - if Lvl(x) >= OnOff(x) then Lvl(x) = OnOff(x) : Lock(x) = True - else 'fade down - Lvl(x) = Lvl(x) - FadeSpeedDown(x) - if Lvl(x) <= 0 then Lvl(x) = 0 : Lock(x) = True - end if - end if - Next - End Sub - - Public Sub Update2() 'Both updates on -1 timer (Lowest latency, but less accurate fading at 60fps vsync) - FrameTime = gametime - InitFrame : InitFrame = GameTime 'Calculate frametime - dim x : for x = 0 to uBound(OnOff) - if not Lock(x) then 'and not Loaded(x) then - if OnOff(x) > 0 then 'Fade Up - Lvl(x) = Lvl(x) + FadeSpeedUp(x) * FrameTime - if Lvl(x) >= OnOff(x) then Lvl(x) = OnOff(x) : Lock(x) = True - else 'fade down - Lvl(x) = Lvl(x) - FadeSpeedDown(x) * FrameTime - if Lvl(x) <= 0 then Lvl(x) = 0 : Lock(x) = True - end if - end if - Next - Update - End Sub - - Public Sub Update() 'Handle object updates. Update on a -1 Timer! If done fading, loaded(x) = True - dim x,xx, aLvl : for x = 0 to uBound(OnOff) - if not Loaded(x) then - aLvl = Lvl(x)*Mult(x) - if IsArray(obj(x) ) Then 'if array - If UseFunction then - for each xx in obj(x) : xx.IntensityScale = cFilter(aLvl) : Next - Else - for each xx in obj(x) : xx.IntensityScale = aLvl : Next - End If - else 'if single lamp or flasher - If UseFunction then - obj(x).Intensityscale = cFilter(aLvl) - Else - obj(x).Intensityscale = aLvl - End If - end if - 'if TypeName(lvl(x)) <> "Double" and typename(lvl(x)) <> "Integer" and typename(lvl(x)) <> "Long" then msgbox "uhh " & 2 & " = " & lvl(x) - 'If UseCallBack(x) then execute cCallback(x) & " " & (Lvl(x)) 'Callback - If UseCallBack(x) then Proc name & x,aLvl 'Proc - If Lock(x) Then - if Lvl(x) = OnOff(x) or Lvl(x) = 0 then Loaded(x) = True 'finished fading - end if - end if - Next - End Sub -End Class - - -'Lamp Filter -Function LampFilter(aLvl) - LampFilter = aLvl^1.6 'exponential curve? -End Function - - -'Helper functions -Sub Proc(string, Callback) 'proc using a string and one argument - 'On Error Resume Next - dim p : Set P = GetRef(String) - P Callback - If err.number = 13 then msgbox "Proc error! No such procedure: " & vbnewline & string - if err.number = 424 then msgbox "Proc error! No such Object" -End Sub - -Function AppendArray(ByVal aArray, aInput) 'append one value, object, or Array onto the end of a 1 dimensional array - if IsArray(aInput) then 'Input is an array... - dim tmp : tmp = aArray - If not IsArray(aArray) Then 'if not array, create an array - tmp = aInput - Else 'Append existing array with aInput array - Redim Preserve tmp(uBound(aArray) + uBound(aInput)+1) 'If existing array, increase bounds by uBound of incoming array - dim x : for x = 0 to uBound(aInput) - if isObject(aInput(x)) then - Set tmp(x+uBound(aArray)+1 ) = aInput(x) - Else - tmp(x+uBound(aArray)+1 ) = aInput(x) - End If - Next - AppendArray = tmp 'return new array - End If - Else 'Input is NOT an array... - If not IsArray(aArray) Then 'if not array, create an array - aArray = Array(aArray, aInput) - Else - Redim Preserve aArray(uBound(aArray)+1) 'If array, increase bounds by 1 - if isObject(aInput) then - Set aArray(uBound(aArray)) = aInput - Else - aArray(uBound(aArray)) = aInput - End If - End If - AppendArray = aArray 'return new array - End If -End Function - -'****************************************************** -'**** END LAMPZ -'****************************************************** - - -'****************************************************** -' LUT -'****************************************************** - -Sub SetLUT 'AXS - Table1.ColorGradeImage = "LUT" & LUTset - -end sub - -Sub LUTBox_Timer - LUTBox.TimerEnabled = 0 - LUTBox.Visible = 0 - -End Sub - -Sub ShowLUT - LUTBox.visible = 1 - - Select Case LUTSet - Case 0: LUTBox.text = "Fleep Natural Dark 1" - Case 1: LUTBox.text = "Fleep Natural Dark 2" - Case 2: LUTBox.text = "Fleep Warm Dark" - Case 3: LUTBox.text = "koke, lut 70" - Case 4: LUTBox.text = "Fleep Warm Vivid Soft" - Case 5: LUTBox.text = "Fleep Warm Vivid Hard" - Case 6: LUTBox.text = "Skitso Natural and Balanced" - Case 7: LUTBox.text = "Skitso Natural High Contrast" - Case 8: LUTBox.text = "Mikeleonheart, lut 80" - Case 9: LUTBox.text = "CalleV Punchy Brightness and Contrast" - Case 10: LUTBox.text = "HauntFreaks Desaturated" - Case 11: LUTBox.text = "Tomate washed out" - Case 12: LUTBox.text = "VPW original 1on1" - Case 13: LUTBox.text = "bassgeige" - Case 14: LUTBox.text = "blacklight" - Case 15: LUTBox.text = "B&W Comic Book" - Case 16: LUTBox.text = "Skitso New Warmer LUT" - Case 17: LUTBox.text = "Original LUT" - End Select - - LUTBox.TimerEnabled = 1 - -End Sub - -Sub SaveLUT - Dim FileObj - Dim ScoreFile - - Set FileObj=CreateObject("Scripting.FileSystemObject") - If Not FileObj.FolderExists(UserDirectory) then - Exit Sub - End if - - if LUTset = "" then LUTset = 17 'failsafe to original - - Set ScoreFile=FileObj.CreateTextFile(UserDirectory & "Sorcerer_LUT.txt",True) - ScoreFile.WriteLine LUTset - Set ScoreFile=Nothing - Set FileObj=Nothing -End Sub - -Sub LoadLUT - Dim FileObj, ScoreFile, TextStr - dim rLine - - Set FileObj=CreateObject("Scripting.FileSystemObject") - If Not FileObj.FolderExists(UserDirectory) then - LUTset=17 - Exit Sub - End if - If Not FileObj.FileExists(UserDirectory & "Sorcerer_LUT.txt") then - LUTset=17 - Exit Sub - End if - Set ScoreFile=FileObj.GetFile(UserDirectory & "Sorcerer_LUT.txt") - Set TextStr=ScoreFile.OpenAsTextStream(1,0) - If (TextStr.AtEndOfStream=True) then - Exit Sub - End if - rLine = TextStr.ReadLine - If rLine = "" then - LUTset=17 - Exit Sub - End if - LUTset = int (rLine) - Set ScoreFile = Nothing - Set FileObj = Nothing -End Sub - -Sub ShowLUT_Init - LUTBox.visible = 0 - -End Sub - - - - - - diff --git a/Pole Position (Sonic 1987)2.0/Pole Position (Sonic 1987)2.0.vbs.patch b/Pole Position (Sonic 1987)2.0/Pole Position (Sonic 1987)2.0.vbs.patch deleted file mode 100644 index 52c2875..0000000 --- a/Pole Position (Sonic 1987)2.0/Pole Position (Sonic 1987)2.0.vbs.patch +++ /dev/null @@ -1,97 +0,0 @@ ---- "Pole Position (Sonic 1987)2.0.vbs.original" 2023-11-28 08:57:37.010680546 +0100 -+++ "Pole Position (Sonic 1987)2.0.vbs" 2023-11-28 08:55:02.735368473 +0100 -@@ -1936,6 +1936,31 @@ - ' STAND-UP TARGET INITIALIZATION - '****************************************************** - -+Class StandupTarget -+ Private m_primary, m_prim, m_sw, m_animate -+ -+ Public Property Get Primary(): Set Primary = m_primary: End Property -+ Public Property Let Primary(input): Set m_primary = input: End Property -+ -+ Public Property Get Prim(): Set Prim = m_prim: End Property -+ Public Property Let Prim(input): Set m_prim = input: End Property -+ -+ Public Property Get Sw(): Sw = m_sw: End Property -+ Public Property Let Sw(input): m_sw = input: End Property -+ -+ Public Property Get Animate(): Animate = m_animate: End Property -+ Public Property Let Animate(input): m_animate = input: End Property -+ -+ Public default Function init(primary, prim, sw, animate) -+ Set m_primary = primary -+ Set m_prim = prim -+ m_sw = sw -+ m_animate = animate -+ -+ Set Init = Me -+ End Function -+End Class -+ - 'Define a variable for each stand-up target - Dim ST20, ST21, ST22, ST23, ST6, ST7, ST8, ST9, ST11 ,ST17 ,ST18, ST25 - -@@ -1952,18 +1977,18 @@ - 'You will also need to add a secondary hit object for each stand up (name sw11o, sw12o, and sw13o on the example Table1) - 'these are inclined primitives to simulate hitting a bent target and should provide so z velocity on high speed impacts - --ST20 = Array(sw20, psw20,20, 0) --ST21 = Array(sw21, psw21,21, 0) --ST22 = Array(sw22, psw22,22, 0) --ST23 = Array(sw23, psw23,23, 0) --ST6 = Array(sw6, psw6,6, 0) --ST7 = Array(sw7, psw7,7, 0) --ST8 = Array(sw8, psw8,8, 0) --ST9 = Array(sw9, psw9,9, 0) --ST11 = Array(sw11, psw11,11, 0) --ST17 = Array(sw17, psw17,17, 0) --ST18 = Array(sw18, psw18,18, 0) --ST25 = Array(sw25, psw25,25, 0) -+Set ST20 = (new StandupTarget)(sw20, psw20,20, 0) -+Set ST21 = (new StandupTarget)(sw21, psw21,21, 0) -+Set ST22 = (new StandupTarget)(sw22, psw22,22, 0) -+Set ST23 = (new StandupTarget)(sw23, psw23,23, 0) -+Set ST6 = (new StandupTarget)(sw6, psw6,6, 0) -+Set ST7 = (new StandupTarget)(sw7, psw7,7, 0) -+Set ST8 = (new StandupTarget)(sw8, psw8,8, 0) -+Set ST9 = (new StandupTarget)(sw9, psw9,9, 0) -+Set ST11 = (new StandupTarget)(sw11, psw11,11, 0) -+Set ST17 = (new StandupTarget)(sw17, psw17,17, 0) -+Set ST18 = (new StandupTarget)(sw18, psw18,18, 0) -+Set ST25 = (new StandupTarget)(sw25, psw25,25, 0) - - 'Add all the Stand-up Target Arrays to Stand-up Target Animation Array - ' STAnimationArray = Array(ST1, ST2, ....) -@@ -1987,10 +2012,10 @@ - i = STArrayID(switch) - - PlayTargetSound -- STArray(i)(3) = STCheckHit(Activeball,STArray(i)(0)) -+ STArray(i).animate = STCheckHit(Activeball,STArray(i).primary) - -- If STArray(i)(3) <> 0 Then -- DTBallPhysics Activeball, STArray(i)(0).orientation, STMass -+ If STArray(i).animate <> 0 Then -+ DTBallPhysics Activeball, STArray(i).primary.orientation, STMass - End If - DoSTAnim - End Sub -@@ -1998,7 +2023,7 @@ - Function STArrayID(switch) - Dim i - For i = 0 to uBound(STArray) -- If STArray(i)(2) = switch Then STArrayID = i:Exit Function -+ If STArray(i).sw = switch Then STArrayID = i:Exit Function - Next - End Function - -@@ -2027,7 +2052,7 @@ - Sub DoSTAnim() - Dim i - For i=0 to Ubound(STArray) -- STArray(i)(3) = STAnimate(STArray(i)(0),STArray(i)(1),STArray(i)(2),STArray(i)(3)) -+ STArray(i).animate = STAnimate(STArray(i).primary,STArray(i).prim,STArray(i).sw,STArray(i).animate) - Next - End Sub -