API tools faq
paste
Advertisement
Guest User

Dr Dude 1.5C GI modded

a guest
Sep 21st, 2017
159
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VBScript 59.91 KB | None | 0 0
raw download clone embed print report
  1. '______       ______           _                 _   _ _       _____             _ _            _    ______            
  2. '|  _  \      |  _  \         | |        ___    | | | (_)     |  ___|           | | |          | |   | ___ \          
  3. '| | | |_ __  | | | |_   _  __| | ___   ( _ )   | |_| |_ ___  | |____  _____ ___| | | ___ _ __ | |_  | |_/ /__ _ _   _
  4. '| | | | '__| | | | | | | |/ _` |/ _ \  / _ \/\ |  _  | / __| |  __\ \/ / __/ _ \ | |/ _ \ '_ \| __| |    // _` | | | |
  5. '| |/ /| |_   | |/ /| |_| | (_| |  __/ | (_>  < | | | | \__ \ | |___>  < (_|  __/ | |  __/ | | | |_  | |\ \ (_| | |_| |
  6. '|___/ |_(_)  |___/  \__,_|\__,_|\___|  \___/\/ \_| |_/_|___/ \____/_/\_\___\___|_|_|\___|_| |_|\__| \_| \_\__,_|\__, |
  7. '                                                                                                                 __/ |Size
  8. '                                                                                                                |___/
  9. '                                   ______       _ _         __   _____  _____  _____                                  
  10. '                                   | ___ \     | | |       /  | |  _  ||  _  ||  _  |                                
  11. '                                   | |_/ / __ _| | |_   _  `| | | |_| || |_| || |/' |                                
  12. '                                   | ___ \/ _` | | | | | |  | | \____ |\____ ||  /| |                                
  13. '                                   | |_/ / (_| | | | |_| | _| |_.___/ /.___/ /\ |_/ /                                
  14. '                                   \____/ \__,_|_|_|\__, | \___/\____/ \____/  \___/                                  
  15. '                                                     __/ |                                                            
  16. '                                                    |___/                               '
  17.  
  18.  
  19. 'Dr. Dude (Midway 1990) Version 1.5 for VP10
  20. 'Early development by "gtxJoe" and completed by "wrd1972"
  21. 'Thanks to gtxJoe for the assistance and allowing me to complete this table...which by the way, is my very first VP table...EVER!
  22. 'Extra thanks to "ninuzzu" for the plastics and ramp prims and PITA Mixmaster fixin. Also for the invaluable guidance he has provided me on this journey.
  23. 'Also extra thanks to Cyberpez for the many small 3D jobs and script tweaks.
  24. 'Flasher Domes and by "Dark"
  25. 'White flippers by "Zany"
  26. 'Playfield image rework by "ClarkKent"
  27. 'Desktop table scoring by "32Assassin"
  28. 'Lighting by "wrd1972"
  29. 'HMLF Physics by "wrd1972"
  30. 'Flipper physics by "Rothbauerw" and "wrd1972"
  31. 'DOF by "Arngrim"
  32. 'Mixmaster model and coiled wires 3D models by "nfozzy"
  33. 'Many thanks to countles others for in the VPF community for helping me learn the table creation process.
  34. 'Last but not least, a million Thanks to my wife for tolerating me spending countless  hours in the basement bangin away on a fake pinball machine.
  35.  
  36. Option Explicit
  37. Randomize
  38.  
  39. On Error Resume Next
  40. ExecuteGlobal GetTextFile("controller.vbs")
  41. If Err Then MsgBox "You need the controller.vbs in order to run this table, available in the vp10 package"
  42. On Error Goto 0
  43.  
  44. '*************************************************************************************************************************
  45. Dim OptReset
  46. 'OptReset = 1  'Uncomment to reset to default options in case of error OR keep all changes temporary. Re-comment after table is restarted.
  47. '*************************************************************************************************************************
  48.  
  49. Dim DesktopMode: DesktopMode = Table1.ShowDT
  50.  
  51. If DesktopMode = True Then 'Show Desktop components
  52. Railleft.visible = 1
  53. Railright.visible = 1
  54. Lockdownbar.visible = 1
  55. F17_DT.visible = 1
  56. F18_DT.visible = 1
  57. F19_DT.visible = 1
  58. F20_DT.visible = 1
  59. F21_DT.visible = 1
  60. F17_fs.visible = 0
  61. F18_fs.visible = 0
  62. F19_fs.visible = 0
  63. F20_fs.visible = 0
  64. F21_fs.visible = 0
  65. F36dt.visible = 1
  66. F36adt.visible = 1
  67. F36fs.visible = 0
  68. F36afs.visible = 0
  69. F37dt.visible = 1
  70. F37adt.visible = 1
  71. F37fs.visible = 0
  72. F37afs.visible = 0
  73. F38dt.visible = 1
  74. F38adt.visible = 1
  75. F38fs.visible = 0
  76. F38afs.visible = 0
  77. F57dt.visible = 1
  78. F57adt.visible = 1
  79. F57fs.visible = 0
  80. F57afs.visible = 0
  81. l17_DT.visible = 1
  82. l18_DT.visible = 1
  83. l19_DT.visible = 1
  84. l20_DT.visible = 1
  85. l21_DT.visible = 1
  86. l17_FS.visible = 0
  87. l18_FS.visible = 0
  88. l19_FS.visible = 0
  89. l20_FS.visible = 0
  90. l21_FS.visible = 0
  91. F133_DT.visible = 1
  92. F134_DT.visible = 1
  93. F135_DT.visible = 1
  94. F133_FS.visible = 0
  95. F134_FS.visible = 0
  96. F135_FS.visible = 0
  97. GI1_DT.visible =1
  98. GI2_DT.visible =1
  99. GI3_DT.visible =1
  100. GI1_FS.visible =0
  101. GI2_FS.visible =0
  102. GI3_FS.visible =0
  103. F132_DT.visible =1
  104. F132_FS.visible =0
  105. pSidewall_DTa.visible = 1
  106. pSidewall_FSa.visible = 0
  107.  
  108.  
  109. Else
  110. Railleft.visible = 0
  111. Railright.visible = 0
  112. Lockdownbar.visible = 0
  113. F36dt.visible = 0
  114. F36adt.visible = 0
  115. F36fs.visible = 1
  116. F36afs.visible = 1
  117. F37dt.visible = 0
  118. F37adt.visible = 0
  119. F37fs.visible = 1
  120. F37afs.visible = 1
  121. F38dt.visible = 0
  122. F38adt.visible = 0
  123. F38fs.visible = 1
  124. F38afs.visible = 1
  125. F57dt.visible = 0
  126. F57adt.visible = 0
  127. F57fs.visible = 1
  128. F57afs.visible = 1
  129. l17_DT.visible = 0
  130. l18_DT.visible = 0
  131. l19_DT.visible = 0
  132. l20_DT.visible = 0
  133. l21_DT.visible = 0
  134. l17_FS.visible = 1
  135. l18_FS.visible = 1
  136. l19_FS.visible = 1
  137. l20_FS.visible = 1
  138. l21_FS.visible = 1
  139. F17_DT.visible = 0
  140. F18_DT.visible = 0
  141. F19_DT.visible = 0
  142. F20_DT.visible = 0
  143. F21_DT.visible = 0
  144. F17_fs.visible = 1
  145. F18_fs.visible = 1
  146. F19_fs.visible = 1
  147. F20_fs.visible = 1
  148. F21_fs.visible = 1
  149. F133_DT.visible = 0
  150. F134_DT.visible = 0
  151. F135_DT.visible = 0
  152. F133_FS.visible = 1
  153. F134_FS.visible = 1
  154. F135_FS.visible = 1
  155. GI1_DT.visible =0
  156. GI2_DT.visible =0
  157. GI3_DT.visible =0
  158. GI1_FS.visible =1
  159. GI2_FS.visible =1
  160. GI3_FS.visible =1
  161. F132_DT.visible =0
  162. F132_FS.visible =1
  163. pSidewall_DTa.visible = 0
  164. pSidewall_FSa.visible = 1
  165. End if
  166.  
  167. ' DMD Rotation
  168. Const cDMDRotation              = -1            '-1 for No change, 0 - DMD rotation of 0?, 1 - DMD rotation of 90?
  169. Const cGameName                 = "dd_l2"       'ROM name
  170. dim aproncolor, flipperstyle, cheaterpost, raybeam, MMflashers
  171.  
  172.  
  173. Const ballsize = 50
  174. Const ballmass = 1.7
  175. LoadVPM "00990300", "s11.VBS",3.10
  176.  
  177. '********************
  178. 'Standard definitions
  179. '********************
  180. Const UseSolenoids = 1
  181. Const UseLamps = 0
  182. Const UseSync = 1
  183. Const HandleMech = 0
  184.  
  185. 'Standard Sounds
  186. Const SSolenoidOn = "fx_Solenoid"
  187. Const SSolenoidOff = ""
  188. Const SFlipperOn = ""
  189. Const SFlipperOff = ""
  190. Const SCoin = "fx_coin"
  191.  
  192.  
  193.  
  194.  
  195. '********************
  196. 'Table Init
  197. '********************
  198.  
  199. Dim bsTrough, DTRBank1, ttcentre, mMagnet, FastFlips
  200.  
  201. Sub Table1_Init
  202.     vpmInit Me
  203.     With Controller
  204.         .GameName = cGameName
  205.         .SplashInfoLine = "Dr. Dude (Bally 1990)"
  206.         .HandleKeyboard = 0
  207.         .ShowTitle = 0
  208.         .ShowDMDOnly = 1
  209.         .ShowFrame = 0
  210.         .HandleMechanics = 1
  211.         .Hidden = 1
  212.  
  213.         if cDMDRotation >= 0 Then .Games(cGameName).Settings.Value("rol") = cDMDRotation
  214.  
  215.         On Error Resume Next
  216.         .Run GetPlayerHWnd
  217.         If Err Then MsgBox Err.Description
  218.     End With
  219.  
  220.     On Error Goto 0
  221.  
  222.  
  223.     'Nudging
  224.     vpmNudge.TiltSwitch=1
  225.     vpmNudge.Sensitivity=5
  226.     vpmNudge.TiltObj=Array(Bumper1,Bumper2,Bumper3,LeftSlingshot,RightSlingshot)
  227.  
  228.     Set FastFlips = new cFastFlips
  229.     with FastFlips
  230.         .CallBackL = "SolLflipper"  'Point these to flipper subs
  231.         .CallBackR = "SolRflipper"  '...
  232.         .TiltObjects = True 'if True calls vpmnudge.solgameon automatically (which in turn disables slings & bumpers)
  233.     '   .DebugOn = False        'Debug, always-on flippers. Call FastFlips.DebugOn True or False in debugger to enable/disable.
  234.     end with
  235.  
  236.    'Trough
  237.     Set bsTrough=New cvpmBallStack
  238.         with bsTrough
  239.             .InitSw 0,11,12,13,0,0,0,0
  240.             .InitKick BallRelease,0,12
  241.             .Balls=3
  242.             .InitExitSnd SoundFX("fx_ballrel",DOFContactors) , SoundFX("fx_Solenoid",DOFContactors)
  243.         End With
  244.    
  245.  
  246.  
  247.  
  248.  
  249.     'DropTargets
  250.     Set dtrbank1 = New cvpmDropTarget
  251.         dtrbank1.InitDrop Array(sw21, sw22, sw23, sw24), Array(21,22,23,24)
  252.         dtrbank1.InitSnd SoundFX("Droptarget",DOFContactors),SoundFX("Droptargetreset",DOFContactors)
  253.  
  254.  
  255.  
  256.  
  257.     ' Disc
  258.     Set ttcentre = new cvpmTurnTable
  259.     ttcentre.InitTurnTable trMixMaster,240
  260.     ttcentre.CreateEvents "ttcentre"
  261.     ttcentre.SpinUp = 240
  262.     ttcentre.SpinDown = 240
  263.  
  264.     ' Magnet
  265.     Set mMagnet = New cvpmMagnet
  266.         With mMagnet
  267.             .InitMagnet magnetTrigger, 10
  268.             .CreateEvents "mMagnet"
  269.             .Solenoid = 13
  270.             .GrabCenter = False
  271.         End With
  272.  
  273.     Dim obj
  274.     For Each obj In colLampPoles:obj.IsDropped = 1:Next
  275.     colLampPoles(2).isdropped = 0
  276.  
  277.     '**Main Timer init
  278.    PinMAMETimer.Enabled = 1
  279.  
  280.     SolGI 0
  281.  
  282. End Sub
  283.  
  284.  
  285. Sub B2SCommand(nr, state)
  286.     If B2SOn Then
  287.         Controller.B2SSetData nr, state
  288.     End If
  289. End Sub
  290.  
  291. Sub Table_Paused:Controller.Pause = 1:End Sub
  292. Sub Table_unPaused:Controller.Pause = 0:End Sub
  293. Sub Table1_Exit():Controller.Stop:End Sub
  294.  
  295.  
  296. '********************
  297. '       KEYS
  298. '********************
  299.  
  300. Sub Table1_KeyDown(ByVal keycode)
  301.     If keycode = PlungerKey Then Plunger.PullBack:PlaySound "plungerpull"
  302.     If keycode = LeftFlipperKey Then Controller.Switch(58) = 1 : FastFlips.FlipL True
  303.     If keycode = RightFlipperKey Then Controller.Switch(57) = 1 : FastFlips.FlipR True
  304.     If keycode = LeftTiltKey Then Nudge 90,2: Playsound SoundFX("fx_nudge",0)
  305.     If keycode = RightTiltKey Then Nudge 270,2: Playsound SoundFX("fx_nudge",0)
  306.     If keycode = CenterTiltKey Then Nudge 0,3: Playsound SoundFX("fx_nudge",0)
  307.     '* Test Kicker
  308. '   If keycode = 37 Then TestKick ' K kick ball in test kicker
  309. '   If keycode = 19 Then return_to_test ' R return ball to kicker
  310. '   If keycode = 46 Then create_testball ' C create ball ball in test kicker
  311. '   If keycode = 205 Then TKickAngle = TKickAngle + 3:KickDirection.Visible=1:KickDirection.RotZ=TKickAngle+90 ' right arrow
  312. '   If keycode = 203 Then TKickAngle = TKickAngle - 3:KickDirection.Visible=1:KickDirection.RotZ=TKickAngle+90 'left arrow
  313. '   If keycode = 200 Then TKickPower = TKickPower + 2:debug.print "TKickPower: "&TKickPower ' up arrow
  314. '   If keycode = 208 Then TKickPower = TKickPower - 2:debug.print "TKickPower: "&TKickPower ' down arrow
  315.  
  316.     If vpmKeyDown(keycode) Then Exit Sub
  317. End Sub
  318.  
  319. Sub Table1_KeyUp(ByVal keycode)
  320.     If keycode = PlungerKey Then Plunger.Fire:PlaySound "plunger"
  321.     If keycode = LeftFlipperKey Then Controller.Switch(58) = 0 : FastFlips.FlipL False
  322.     If keycode = RightFlipperKey Then Controller.Switch(57) = 0 : FastFlips.FlipR False
  323.  
  324.     '* Test Kicker
  325.     If keycode = 205 Then KickDirection.Visible=0 ' right arrow
  326.     If keycode = 203 Then KickDirection.Visible=0 'left arrow
  327.  
  328.     If vpmKeyUp(keycode) Then Exit Sub
  329. End Sub
  330.  
  331.  
  332. '******************************************************
  333. '                   Test Kicker
  334. '******************************************************
  335.  
  336. 'Dim TKickAngle, TKickPower, TKickBall
  337. 'TKickAngle = 0
  338. 'TKickPower = 10
  339.  
  340. 'Sub testkick()
  341. '   test.kick TKickAngle,TKickPower
  342. 'End Sub
  343.  
  344. 'Sub create_testball():Set TKickBall = test.CreateBall:End Sub
  345. 'Sub test_hit():Set TKickBall=ActiveBall:End Sub
  346. 'Sub return_to_test():TKickBall.velx=0:TKickBall.vely=0:TKickBall.x=test.x:TKickBall.y=test.y-50:test.timerenabled=0:End Sub
  347.  
  348.  
  349.  
  350. '*********** SOLENOIDS ************
  351.  
  352. SolCallBack(1)  = "bsTrough.SolIn"
  353. SolCallBack(2)  = "bsTrough.SolOut"
  354. SolCallBack(3)  = "solLeftKicker"
  355. SolCallBack(4)  = "solRightKicker"
  356. SolCallBack(6)  = "vpmSolSound SoundFX(""Knocker"",DOFKnocker),"
  357. SolCallBack(7)  = "dtRBank1.SolDropUp"
  358. SolCallBack(10) = "solGI"
  359. SolCallBack(14) = "solBigGuy"
  360. SolCallBack(15) = "SetLamp 101,"                'Big Guy Flasher
  361. SolCallBack(16) = "solMixer"                    'Mixer Motor
  362. SolCallBack(25) = "SetLamp 125,"                'Mixer Heart Flasher
  363. SolCallBack(26) = "SetLamp 126,"                'Mixer Gab Flasher
  364. SolCallBack(27) = "SetLamp 127,"                'Mixer Magnet Flasher
  365. SolCallBack(28) = "SetLamp 128,"                'Magnet Flasher
  366. SolCallBack(29) = "SetLamp 129,"                'Gab Flasher
  367. SolCallBack(30) = "SetLamp 130,"                'Heart Flasher
  368. SolCallBack(31) = "SetLamp 131,"                'Drop Targets Flasher      
  369. SolCallBack(32) = "SetLamp 132,"                'Raygun Flasher
  370.  
  371. 'SolCallback(sLLFlipper) = "SolLFlipper"
  372. 'SolCallback(sLRFlipper) = "SolRFlipper"
  373. SolCallback(23) = "FastFlips.TiltSol"
  374. Sub SolLFlipper(Enabled)
  375.     If Enabled Then
  376.         LeftFlipper.RotateToEnd
  377.             PlaySound SoundFX("fx_flipperup",DOFContactors), 0, .67, -0.05, 0.05
  378.     Else
  379.         LeftFlipper.RotateToStart
  380.         PlaySound SoundFX("fx_flipperdown",DOFContactors), 0, 1, -0.05, 0.05
  381.     End If
  382. End Sub
  383.  
  384. Sub SolRFlipper(Enabled)
  385.     If Enabled Then
  386.         RightFlipper.RotateToEnd
  387.             PlaySound SoundFX("fx_flipperup",DOFContactors), 0, .67, 0.05, 0.05
  388.     Else
  389.         RightFlipper.RotateToStart
  390.         PlaySound SoundFX("fx_flipperdown",DOFContactors), 0, 1, 0.05, 0.05
  391.     End If
  392. End Sub
  393.  
  394. Sub solLeftKicker (enabled)
  395.     If (enabled and Controller.Switch(51)) Then
  396.         Playsound SoundFX("fx_vuk_exit2",DOFContactors)
  397.         Controller.Switch(51) = 0
  398.         sw51.timerenabled = 1
  399.         sw51.kick 0,40, 3.14/2
  400.     End If
  401. End Sub
  402.  
  403. Dim sw51step
  404.  
  405. Sub sw51_timer()
  406.     Select Case sw51step
  407.         Case 0:Leftupkicker.TransY = 10
  408.         Case 1:Leftupkicker.TransY = 20
  409.         Case 2:Leftupkicker.TransY = 30
  410.         Case 3:'pUpKicker.TransY = 30
  411.         Case 4:
  412.         Case 5:Leftupkicker.TransY = 25
  413.         Case 6:Leftupkicker.TransY = 20
  414.         Case 7:Leftupkicker.TransY = 15
  415.         Case 8:Leftupkicker.TransY = 10
  416.         Case 9:Leftupkicker.TransY = 5
  417.         Case 10:Leftupkicker.TransY = 0:sw51.timerEnabled = 0:sw51step = 0
  418.     End Select
  419.     sw51step = sw51step + 1
  420. End Sub
  421.  
  422.  
  423. Sub solRightKicker (enabled)
  424.     If (enabled) Then
  425.         Playsound SoundFX("fx_vuk_exit2",DOFContactors)
  426.         Controller.Switch(32) = 0
  427.         sw32.timerenabled = 1
  428.         sw32.kick 0,70, 3.14/2
  429.     End If
  430. End Sub
  431.  
  432. Dim sw32step
  433.  
  434. Sub sw32_timer()
  435.     Select Case sw32step
  436.         Case 0:Rightupkicker.TransY = 10
  437.         Case 1:Rightupkicker.TransY = 20
  438.         Case 2:Rightupkicker.TransY = 30
  439.         Case 3:'pUpKicker.TransY = 30
  440.         Case 4:
  441.         Case 5:Rightupkicker.TransY = 25
  442.         Case 6:Rightupkicker.TransY = 20
  443.         Case 7:Rightupkicker.TransY = 15
  444.         Case 8:Rightupkicker.TransY = 10
  445.         Case 9:Rightupkicker.TransY = 5
  446.         Case 10:Rightupkicker.TransY = 0:sw32.timerEnabled = 0:sw32step = 0
  447.     End Select
  448.     sw32step = sw32step + 1
  449. End Sub
  450.  
  451.  
  452.  
  453.  
  454. Sub solBigGuy (enabled)
  455.     If Enabled Then
  456.         PlaySound SoundFX("BigGuyShake",DOFShaker)
  457.         PrimGuyHit
  458.     End If
  459. End Sub
  460. Sub PrimGuyTimer_Timer: PrimGuyMove: End Sub
  461. Dim GuyCnt
  462. Const GuyMoveMax = 20
  463. Sub PrimGuyHit  
  464.     GuyCnt = 0                  'Reset count
  465.     PrimGuyTimer.Interval = 20  'Set timer interval
  466.     PrimGuyTimer.Enabled = 1    'Enable timer
  467. End Sub
  468. Sub PrimGuyMove
  469.     Select Case GuyCnt
  470.         Case 0:     primGuy.RotX = GuyMoveMax * .25
  471.         Case 1:     primGuy.RotX = GuyMoveMax * .50
  472.         Case 2:     primGuy.RotX = GuyMoveMax * .75
  473.         Case 3:     primGuy.RotX = GuyMoveMax
  474.         Case 4:     primGuy.RotX = GuyMoveMax * .25
  475.         Case 5:     primGuy.RotX = GuyMoveMax * .50
  476.         Case 6:     primGuy.RotX = GuyMoveMax * .75
  477.         Case 7:     primGuy.RotX = 0:PrimGuyShake
  478.         Case else:  PrimGuyTimer.Enabled = 0
  479.     End Select
  480.     GuyCnt = GuyCnt + 1
  481. End Sub
  482.  
  483.  
  484. '***Mixmaster motor***
  485. Sub SolMixer(enabled)
  486. if enabled then
  487. ttcentre.MotorOn = True
  488. ttTimer.Enabled = True
  489. Playsound SoundFX("fx_motor",DOFGear),-1,1,0.2
  490. else
  491. ttcentre.MotorOn = False
  492. ttTimer.Enabled = False
  493. StopSound "fx_motor"
  494. end if
  495. end sub
  496.  
  497.  
  498. '***Mixmaster drop posts***
  499. ttTimer.interval = 10
  500. Dim lampLastPos
  501. Sub ttTimer_Timer
  502.     PostMM.RotZ=(PostMM.RotZ + 10) mod 360
  503.     lampLastPos = Int(SpinningDisc.ObjRotz / 10 + .5)
  504.     colLampPoles(lampLastPos).IsDropped = True
  505.     SpinningDisc.ObjRotZ = (SpinningDisc.ObjRotz + 10) mod 360
  506.     lampLastPos = Int(SpinningDisc.ObjRotz / 10 + .5)
  507.     colLampPoles(lampLastPos).IsDropped = False
  508. End Sub
  509.  
  510.  
  511. Sub Wall100_Hit
  512.     Wall100Cnt = Wall100Cnt + 1
  513.     If Wall100Cnt >= Wall100Max Then Wall100.IsDropped = True
  514.     debug.print Wall100Cnt & " , " & Wall100Max
  515. End Sub
  516.  
  517. Sub Drain_Hit()
  518.     vpmTimer.PulseSw 10
  519.     bsTrough.AddBall Me
  520.     PlaySound "drain"
  521. End Sub
  522.  
  523. '****************
  524. '  POP BUMPERS
  525. '****************
  526.  
  527. Dim Bumper1Cnt,Bumper2Cnt,Bumper3Cnt
  528. Const BumperMoveMax = 25
  529. Sub Bumper1_Hit
  530.         vpmTimer.PulseSw 52
  531.         Playsound SoundFX("fx_bumper1",DOFContactors)
  532.         Bumper1Hit
  533. End Sub
  534. Sub Bumper1_Timer: Bumper1Move: End Sub
  535. Sub Bumper1Hit  
  536.     Bumper1Cnt = 0                  'Reset count
  537.    Bumper1.TimerInterval = 20  'Set timer interval
  538.    Bumper1.TimerEnabled = 1    'Enable timer
  539. End Sub
  540.  
  541. Sub Bumper1Move
  542.     Select Case Bumper1Cnt
  543.         Case 0:     Bumper1Cap.TransY = -BumperMoveMax * .25 :   Bumper1CapS.TransZ = BumperMoveMax * .25 :   BR1.TransY = -BumperMoveMax * .25
  544.         Case 1:     Bumper1Cap.TransY = -BumperMoveMax * .50 :   Bumper1CapS.TransZ = BumperMoveMax * .50 :   BR1.TransY = -BumperMoveMax * .50
  545.         Case 2:     Bumper1Cap.TransY = -BumperMoveMax * .75 :   Bumper1CapS.TransZ = BumperMoveMax * .75 :   BR1.TransY = -BumperMoveMax * .75
  546.         Case 3:     Bumper1Cap.TransY = -BumperMoveMax        :  Bumper1CapS.TransZ = BumperMoveMax :  br1.TransY = -BumperMoveMax
  547.         Case 4:     Bumper1Cap.TransY = -BumperMoveMax * .25 :   Bumper1CapS.TransZ = BumperMoveMax * .25 :   BR1.TransY = -BumperMoveMax * .25
  548.         Case 5:     Bumper1Cap.TransY = -BumperMoveMax * .50 :   Bumper1CapS.TransZ = BumperMoveMax * .50 :   BR1.TransY = -BumperMoveMax * .50
  549.         Case 6:     Bumper1Cap.TransY = -BumperMoveMax * .75 :   Bumper1CapS.TransZ = BumperMoveMax * .75 :   BR1.TransY = -BumperMoveMax * .75
  550.         Case 7:     Bumper1Cap.TransY = 0 : Bumper1CapS.TransZ = 0 : br1.TransY = 0
  551.         Case else:  Bumper1.TimerEnabled = 0
  552.     End Select
  553.     Bumper1Cnt = Bumper1Cnt + 1
  554. End Sub
  555.  
  556.  
  557. Sub Bumper2_Hit
  558.         vpmTimer.PulseSw 53
  559.         Playsound SoundFX("fx_bumper2",DOFContactors)
  560.         Bumper2Hit
  561. End Sub
  562. Sub Bumper2_Timer: Bumper2Move: End Sub
  563. Sub Bumper2Hit  
  564.     Bumper2Cnt = 0                  'Reset count
  565.    Bumper2.TimerInterval = 20  'Set timer interval
  566.    Bumper2.TimerEnabled = 1    'Enable timer
  567. End Sub
  568.  
  569. Sub Bumper2Move
  570.     Select Case Bumper2Cnt
  571.         Case 0:     Bumper2Cap.TransY = -BumperMoveMax * .25 :   Bumper2CapS.TransZ = BumperMoveMax * .25 :   BR2.TransY = -BumperMoveMax * .25
  572.         Case 1:     Bumper2Cap.TransY = -BumperMoveMax * .50 :   Bumper2CapS.TransZ = BumperMoveMax * .50 :   BR2.TransY = -BumperMoveMax * .50
  573.         Case 2:     Bumper2Cap.TransY = -BumperMoveMax * .75 :   Bumper2CapS.TransZ = BumperMoveMax * .75 :   BR2.TransY = -BumperMoveMax * .75
  574.         Case 3:     Bumper2Cap.TransY = -BumperMoveMax        :  Bumper2CapS.TransZ = BumperMoveMax :  br2.TransY = -BumperMoveMax
  575.         Case 4:     Bumper2Cap.TransY = -BumperMoveMax * .25 :   Bumper2CapS.TransZ = BumperMoveMax * .25 :   BR2.TransY = -BumperMoveMax * .25
  576.         Case 5:     Bumper2Cap.TransY = -BumperMoveMax * .50 :   Bumper2CapS.TransZ = BumperMoveMax * .50 :   BR2.TransY = -BumperMoveMax * .50
  577.         Case 6:     Bumper2Cap.TransY = -BumperMoveMax * .75 :   Bumper2CapS.TransZ = BumperMoveMax * .75 :   BR2.TransY = -BumperMoveMax * .75
  578.         Case 7:     Bumper2Cap.TransY = 0 : Bumper2CapS.TransZ = 0 : br2.TransY = 0
  579.         Case else:  Bumper2.TimerEnabled = 0
  580.     End Select
  581.     Bumper2Cnt = Bumper2Cnt + 1
  582. End Sub
  583.  
  584.  
  585. Sub Bumper3_Hit
  586.         vpmTimer.PulseSw 54
  587.         Playsound SoundFX("fx_bumper3",DOFContactors)
  588.         Bumper3Hit
  589. End Sub
  590. Sub Bumper3_Timer: Bumper3Move: End Sub
  591. Sub Bumper3Hit  
  592.     Bumper3Cnt = 0                  'Reset count
  593.    Bumper3.TimerInterval = 20  'Set timer interval
  594.    Bumper3.TimerEnabled = 1    'Enable timer
  595. End Sub
  596.  
  597. Sub Bumper3Move
  598.     Select Case Bumper3Cnt
  599.         Case 0:     Bumper3Cap.TransY = -BumperMoveMax * .25 :   Bumper3CapS.TransZ = BumperMoveMax * .25 :   BR3.TransY = -BumperMoveMax * .25
  600.         Case 1:     Bumper3Cap.TransY = -BumperMoveMax * .50 :   Bumper3CapS.TransZ = BumperMoveMax * .50 :   BR3.TransY = -BumperMoveMax * .50
  601.         Case 2:     Bumper3Cap.TransY = -BumperMoveMax * .75 :   Bumper3CapS.TransZ = BumperMoveMax * .75 :   BR3.TransY = -BumperMoveMax * .75
  602.         Case 3:     Bumper3Cap.TransY = -BumperMoveMax        :  Bumper3CapS.TransZ = BumperMoveMax :  br3.TransY = -BumperMoveMax
  603.         Case 4:     Bumper3Cap.TransY = -BumperMoveMax * .25 :   Bumper3CapS.TransZ = BumperMoveMax * .25 :   BR3.TransY = -BumperMoveMax * .25
  604.         Case 5:     Bumper3Cap.TransY = -BumperMoveMax * .50 :   Bumper3CapS.TransZ = BumperMoveMax * .50 :   BR3.TransY = -BumperMoveMax * .50
  605.         Case 6:     Bumper3Cap.TransY = -BumperMoveMax * .75 :   Bumper3CapS.TransZ = BumperMoveMax * .75 :   BR3.TransY = -BumperMoveMax * .75
  606.         Case 7:     Bumper3Cap.TransY = 0 : Bumper3CapS.TransZ = 0 : br3.TransY = 0
  607.         Case else:  Bumper3.TimerEnabled = 0
  608.     End Select
  609.     Bumper3Cnt = Bumper3Cnt + 1
  610. End Sub
  611.  
  612.  
  613. '**********Sling Shots and Animations
  614. ' Rstep and Lstep  are the variables that increment the animation
  615. '****************
  616. Dim RStep, Lstep
  617.  
  618. Sub LeftSlingShot_Slingshot
  619.     PlaySound SoundFX("left_slingshot",DOFContactors),0,1,-0.05,0.05
  620.     LSling.Visible = 0
  621.     LSling1.Visible = 1
  622.     sling2.TransZ = -20
  623.     LStep = 0
  624.     LeftSlingShot.TimerEnabled = 1
  625.     vpmTimer.PulseSw 55
  626.     'gi1.State = 0:Gi2.State = 0
  627. End Sub
  628.  
  629. Sub LeftSlingShot_Timer
  630.     Select Case LStep
  631.         Case 1:LSLing1.Visible = 0:LSLing2.Visible = 1:sling2.TransZ = -10
  632.         Case 2:LSLing2.Visible = 0:LSLing.Visible = 1:sling2.TransZ = 0:LeftSlingShot.TimerEnabled = 0:'gi1.State = 1:Gi2.State = 1
  633.    End Select
  634.     LStep = LStep + 1
  635. End Sub
  636.  
  637. Sub RightSlingShot_Slingshot
  638.     PlaySound SoundFX("right_slingshot",DOFContactors), 0, 1, 0.05, 0.05
  639.     RSling.Visible = 0
  640.     RSling1.Visible = 1
  641.     sling1.TransZ = -20
  642.     RStep = 0
  643.     RightSlingShot.TimerEnabled = 1
  644.     vpmTimer.PulseSw 56
  645.     'gi1.State = 0:Gi2.State = 0
  646. End Sub
  647.  
  648. Sub RightSlingShot_Timer
  649.     Select Case RStep
  650.         Case 1:RSLing1.Visible = 0:RSLing2.Visible = 1:sling1.TransZ = -10
  651.         Case 2:RSLing2.Visible = 0:RSLing.Visible = 1:sling1.TransZ = 0:RightSlingShot.TimerEnabled = 0:'gi1.State = 1:Gi2.State = 1
  652.    End Select
  653.     RStep = RStep + 1
  654. End Sub
  655.  
  656.  
  657. Sub wall83_Hit:vpmTimer.PulseSw 100:rubberback1.visible = 0::rubberback1a.visible = 1:wall83.timerenabled = 1:End Sub
  658. Sub wall83_timer:rubberback1.visible = 1::rubberback1a.visible = 0: wall83.timerenabled= 0:End Sub
  659.  
  660. Sub Wall2_Hit:vpmTimer.PulseSw 100:MMrubberl.visible = 0::MMrubberla.visible = 1:Wall2.timerenabled = 1:End Sub
  661. Sub Wall2_timer:MMrubberl.visible = 1::MMrubberla.visible = 0: Wall2.timerenabled= 0:End Sub
  662.  
  663. Sub Wall3_Hit:vpmTimer.PulseSw 100:MMrubberR.visible = 0::MMrubberRa.visible = 1:Wall3.timerenabled = 1:End Sub
  664. Sub Wall3_timer:MMrubberR.visible = 1::MMrubberRa.visible = 0: Wall3.timerenabled= 0:End Sub
  665.  
  666.  
  667. Sub Wall233_Hit:vpmTimer.PulseSw 100:Rubber_white_1.visible = 0::Rubber_white_1a.visible = 1:Wall233.timerenabled = 1:End Sub
  668. Sub Wall233_timer:Rubber_white_1.visible = 1::Rubber_white_1a.visible = 0: Wall233.timerenabled= 0:End Sub
  669.  
  670. Sub Wall101_Hit:vpmTimer.PulseSw 100:Rubber_white_3.visible = 0::Rubber_white_3a.visible = 1:Wall101.timerenabled = 1: vpmTimer.PulseSw 39: End Sub
  671. Sub Wall101_timer:Rubber_white_3.visible = 1::Rubber_white_3a.visible = 0: Wall101.timerenabled= 0:End Sub
  672.  
  673.  
  674.  
  675. ' ************************
  676. '           GI
  677. ' ************************
  678.  
  679. Sub solGI(enabled)  '   'SetLamp 100, abs(not enabled)
  680.     If enabled Then
  681.         GIoff   '
  682.         Playsound "fx_relay_off"
  683.     Else
  684.         GIon
  685.         Playsound "fx_relay_on"
  686.     End If
  687. End Sub
  688.  
  689. Sub GIoff()
  690.     dim xx : For each xx in GI:xx.State = 0: Next  
  691.     SetLamp 100, 0
  692. End Sub
  693.  
  694. Sub GIon()
  695.     dim xx : For each xx in GI:xx.State = 1: Next
  696.     SetLamp 100, 1
  697. End Sub
  698.  
  699.  
  700. ' ************************
  701. '      RealTime Updates
  702. ' ************************
  703.  
  704. 'Set MotorCallback = GetRef("GameTimer")
  705.  
  706. Sub GameTimer_Timer
  707.     UpdateMechs
  708.     RollingSoundsUpdate
  709. End Sub
  710.  
  711. dim defaultEOS,EOSAngle,EOSTorque
  712. defaulteos = leftflipper.eostorque
  713. EOSAngle = 3
  714. EOSTorque = .9
  715.  
  716. Sub UpdateMechs
  717.     flipperL.RotZ = LeftFlipper.CurrentAngle
  718.     flipperR.RotZ = RightFlipper.CurrentAngle
  719.  
  720.     If LeftFlipper.CurrentAngle < LeftFlipper.EndAngle + EOSAngle Then
  721.         LeftFlipper.eostorque = EOSTorque
  722.     Else
  723.         LeftFlipper.eostorque = defaultEOS
  724.     End If
  725.  
  726.     If RightFlipper.CurrentAngle > RightFlipper.EndAngle - EOSAngle Then
  727.         RightFlipper.eostorque = EOSTorque
  728.     Else
  729.         RightFlipper.eostorque = defaultEOS
  730.     End If
  731.  
  732. End Sub
  733.  
  734.  
  735. Dim primCnt(100), primDir(100), primBmprDir(6)
  736. '****************************************************************************
  737. '***** Primitive Standup Target Animation
  738. '****************************************************************************
  739. 'USAGE:     Sub sw1_Hit:    PrimStandupTgtHit  1, Sw1, PrimSw1: End Sub
  740. 'USAGE:     Sub Sw1_Timer:  PrimStandupTgtMove 1, Sw1, PrimSw1: End Sub
  741.  
  742. Const StandupTgtMovementDir = "TransX"
  743. Const StandupTgtMovementMax = 6  
  744.  
  745. Sub PrimStandupTgtHit (swnum, wallName, primName)  
  746.     PlaySound SoundFx("target",DOFContactors)
  747.     vpmTimer.PulseSw swnum 
  748.     primCnt(swnum) = 0                                  'Reset count
  749.     wallName.TimerInterval = 20     'Set timer interval
  750.     wallName.TimerEnabled = 1   'Enable timer
  751.     Debug.print "Hit"
  752. End Sub
  753.  
  754. Sub PrimStandupTgtMove (swnum, wallName, primName)
  755.     Select Case StandupTgtMovementDir
  756.         Case "TransX":
  757.             Select Case primCnt(swnum)
  758.                 Case 0:     primName.TransX = -StandupTgtMovementMax * .5
  759.                 Case 1:     primName.TransX = -StandupTgtMovementMax
  760.                 Case 2:     primName.TransX = -StandupTgtMovementMax * .5
  761.                 Case 3:     primName.TransX = 0
  762.                 Case else:  wallName.TimerEnabled = 0
  763.             End Select
  764.         Case "TransY":
  765.             Select Case primCnt(swnum)
  766.                 Case 0:     primName.TransY = -StandupTgtMovementMax * .5
  767.                 Case 1:     primName.TransY = -StandupTgtMovementMax
  768.                 Case 2:     primName.TransY = -StandupTgtMovementMax * .5
  769.                 Case 3:     primName.TransY = 0
  770.                 Case else:  wallName.TimerEnabled = 0
  771.             End Select
  772.         Case "TransZ":
  773.             Select Case primCnt(swnum)
  774.                 Case 0:     primName.TransZ = -StandupTgtMovementMax * .5
  775.                 Case 1:     primName.TransZ = -StandupTgtMovementMax
  776.                 Case 2:     primName.TransZ = -StandupTgtMovementMax * .5
  777.                 Case 3:     primName.TransZ = 0
  778.                 Case else:  wallName.TimerEnabled = 0
  779.             End Select         
  780.     End Select
  781.     primCnt(swnum) = primCnt(swnum) + 1
  782. End Sub
  783.  
  784.  
  785.  
  786. ' ************************
  787. '      Gates
  788. ' ************************
  789. 'Sub Gate1_Hit():PlaySound "gate":End Sub
  790. Sub Gate2_Hit():PlaySound "gate":End Sub
  791. Sub Gate3_Hit():PlaySound "gate":End Sub
  792. Sub trigger1_Hit():PlaySound "gate":End Sub
  793.  
  794.  
  795.  
  796.  
  797.  
  798. ' ************************
  799. '      Switches
  800. ' ************************
  801.  
  802. sub sw9_hit:   controller.switch(9)=1: playsound "rollover": end sub
  803. sub sw9_unhit: controller.switch(9)=0
  804.     If ActiveBall.VelY < 0 Then 'on the way up
  805.    End If
  806. End Sub
  807. Sub sw14_Hit:vpmTimer.PulseSw(14):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  808. 'Sub Standup27_Hit:vpmTimer.pulseSw 27:Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  809.  
  810. Sub sw15_Hit:Controller.Switch(15) = 1
  811.     If ActiveBall.VelY < 0 Then 'on the way up
  812.        PlaySound "fx_rrenter", 0, 1, pan(ActiveBall)
  813.     End If
  814. End Sub
  815.  
  816. Sub sw15_Unhit:Controller.Switch(15) = 0:End Sub
  817. sub sw16_hit:   controller.switch(16)=1: playsound "rollover": end sub
  818. sub sw16_unhit: controller.switch(16)=0: end sub
  819. sub sw17_hit:   controller.switch(17)=1: playsound "rollover": end sub
  820. sub sw17_unhit: controller.switch(17)=0: end sub
  821. sub sw18_hit:   controller.switch(18)=1: playsound "rollover": end sub
  822. sub sw18_unhit: controller.switch(18)=0: end sub
  823. sub sw19_hit:   controller.switch(19)=1: playsound "rollover": end sub
  824. sub sw19_unhit: controller.switch(19)=0: end sub
  825. sub sw20_hit:   controller.switch(20)=1: playsound "rollover": end sub
  826. sub sw20_unhit: controller.switch(20)=0: end sub
  827. sub sw21_hit: dtrbank1.hit 1: Playsound "droptarget": end sub
  828. sub sw22_hit: dtrbank1.hit 2: Playsound "droptarget": end sub
  829. sub sw23_hit: dtrbank1.hit 3: Playsound "droptarget": end sub
  830. sub sw24_hit: dtrbank1.hit 4: Playsound "droptarget": end sub
  831. Sub sw25_Hit:vpmTimer.PulseSw(25):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  832. Sub sw26_Hit:vpmTimer.PulseSw(26):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  833. Sub sw27_Hit:vpmTimer.PulseSw(27):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  834. Sub sw28_Hit:vpmTimer.PulseSw(28):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  835. Sub sw29_Hit:vpmTimer.PulseSw(29):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  836. Sub sw30_Hit:vpmTimer.PulseSw(30):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  837. Sub sw31_Hit:vpmTimer.PulseSw(31):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  838. Sub sw32_Hit:   Controller.Switch(32) = 1:Playsound "fx_saucer_enter": Sw32.Enabled = 0:End Sub
  839.  
  840.  
  841. Sub Sw32Trigger_Hit
  842.     debug.print activeball.vely
  843.     If activeball.vely > -10 Then
  844.         Sw32.Enabled = 1
  845.     Else
  846.         Sw32.Enabled = 0
  847.     End If
  848. End Sub
  849.  
  850.  
  851. Sub sw33_Hit:vpmTimer.PulseSw(33):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  852. Sub sw34_Hit:vpmTimer.PulseSw(34):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  853. Sub sw35_Hit:vpmTimer.PulseSw(35):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  854. Sub sw36_Hit:vpmTimer.PulseSw(36):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  855. Sub sw37_Hit:vpmTimer.PulseSw(37):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  856. Sub sw38_Hit:vpmTimer.PulseSw(38):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  857. 'sub sw39_hit:   vpmTimer.PulseSw 39: debug.print "39":end sub
  858. Sub sw41_Hit:vpmTimer.PulseSw(41):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  859. Sub sw42_Hit:vpmTimer.PulseSw(42):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  860. Sub sw43_Hit:vpmTimer.PulseSw(43):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  861. sub sw46_hit:   vpmTimer.PulseSw 46: debug.print "46":end sub
  862. sub sw47_hit:   vpmTimer.PulseSw 47: debug.print "47":end sub
  863. sub sw48_hit:   vpmTimer.PulseSw 48: debug.print "48":end sub
  864. Sub sw49_Hit:vpmTimer.PulseSw(49):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  865. Sub sw50_Hit:vpmTimer.PulseSw(50):Playsound SoundFX("fx_target",DOFTargets):Me.TimerEnabled = 1: End Sub
  866. Sub sw51_Hit:   Controller.Switch(51) = 1:Playsound "fx_saucer_enter": Sw51.Enabled = 0:End Sub
  867.  
  868. Sub Sw51Trigger_Hit
  869.     'debug.print activeball.vely
  870.     If activeball.vely > -10 Then
  871.         Sw51.Enabled = 1
  872.     Else
  873.         Sw51.Enabled = 0
  874.     End If
  875. End Sub
  876.  
  877. sub sw59_hit:   controller.switch(59)=1: playsound "rollover": end sub
  878. sub sw59_unhit: controller.switch(59)=0: end sub
  879.  
  880.  
  881. '***************************************************
  882. 'GI collection Lamp/Flasher sorting and GiOFF scaling init
  883. '***************************************************
  884.  
  885. 'redim GILamps(99) : redim GIFlashers(99)   'Splits GI collection into these two new arrays (not applicable here because no flashers)
  886.  
  887. 'SortGI GILamps, GIFlashers, GI
  888.  
  889. 'dim TestString     'debug strings
  890. 'Sub SortGI(ByRef aLight,aFlasher, GImixed) 'different method using Arrays instead of scripting dictionary objects
  891. '   dim x, CountMe: CountMe = 0
  892. '   for x = 0 to (GImixed.Count-1)
  893. '       if TypeName(GImixed(x) ) = "Light" Then
  894. '           Set aLight(CountMe) = GImixed(x)
  895. '           TestString = TestString & "assigned " & GImixed(x).Name & " to aLight(" & CountMe & ")" & vbnewline 'debug
  896. '           CountMe = CountMe+1
  897. '           redim Preserve aLight(CountMe)
  898. '       end if
  899. '   Next
  900. '   CountMe = 0
  901. '   for x = 0 to (GImixed.Count-1)  '(note: this sub assumes there ARE flashers in the collection!)
  902. '       if TypeName(GImixed(x) ) = "Flasher" Then
  903. '           Set aFlasher(CountMe) = GImixed(x)
  904. '           TestString = TestString & "assigned " & GImixed(x).Name & " to aFlasher(" & CountMe & ")" & vbnewline   'debug
  905. '           CountMe = CountMe+1
  906. '           redim Preserve aFlasher(CountMe)
  907. '       end if
  908. '   Next
  909. '   redim Preserve aLight(uBound(aLight)-1) 'final trim of the arrays
  910. '   redim Preserve aFlasher(uBound(aFlasher)-1)
  911. '   'TestSTR(0) = TestSTR(0) & "ubound aLight: " & uBound(aLight) & " uBound aFlashers:" & uBound(aFlasher) 'debug
  912. '   'Debug.Print TestString
  913. 'End Sub
  914.  
  915.  
  916. 'These arrays contain the following info of all non-GI lights (collected from GetElements via SortLamps sub)
  917. Redim LightsA(999)' Object references
  918. Redim LightsB(999)' Opacity / Intensity
  919. Redim LightsC(999)' Fade Up (Light objects)
  920. Redim LightsD(999)' Fade Down(Light Objects)
  921.  
  922. SortLamps GI
  923.  
  924. dim TestStringAll
  925. Sub SortLamps(ByVal aGI)    'Sorts remaining light and flashers objects (EXCLUDES those in the GI collection)
  926.     dim Counter,x,xx,skipme : skipme = False:Counter = 0 : TestStringAll = "Test String 2"
  927.     for each x in GetElements   'toomuchcoffee.vbs
  928.         'if TypeName(x) = "IDecal" then Continue For 'Decals don't have names. Evil imo D:
  929.         if TypeName(x) = "Light" or TypeName(x) = "Flasher" Then
  930.             SkipMe = False
  931.             for each xx in aGI 'Find duplicates and Skip them
  932.                 if x.Name = xx.Name then
  933.                     TestStringAll = TestStringAll & x.Name & "found in GI collection, Disregarding & Continuing..." & vbnewline 'debug
  934.                     SkipMe = True'Continue For
  935.                 End If
  936.             next
  937.             If Not SkipMe Then
  938.                 On Error Resume Next
  939.                 'LightsA(Counter) = x.name  'name
  940.                 Set LightsA(Counter) = x    'ref
  941.                 LightsB(Counter) = x.Opacity
  942.                 LightsB(Counter) = x.Intensity
  943.                 LightsC(Counter) = x.FadeSpeedUp
  944.                 LightsD(Counter) = x.FadeSpeedDown
  945.                 On Error Goto 0
  946.                 Counter = Counter + 1
  947.                 redim Preserve LightsA(Counter)
  948.                 redim Preserve LightsB(Counter)
  949.                 redim Preserve LightsC(Counter)
  950.                 redim Preserve LightsD(Counter)
  951.             End If
  952.         End If
  953.     next
  954.     redim Preserve LightsA(uBound(LightsA)-1)   'final trim of the arrays
  955.     redim Preserve LightsB(uBound(LightsB)-1)
  956.     redim Preserve LightsC(uBound(LightsC)-1)
  957.     redim Preserve LightsD(uBound(LightsD)-1)
  958.  
  959.     TestStringAll = TestStringAll & "Ubound LightsA = " & UBound(LightsA)   'Debug
  960. End Sub
  961.  
  962. '***************************************************
  963. '       JP's VP10 Fading Lamps & Flashers
  964. '       Based on PD's Fading Light System
  965. ' SetLamp 0 is Off
  966. ' SetLamp 1 is On
  967. ' fading for non opacity objects is 4 steps
  968. '***************************************************
  969.  
  970.  
  971. Dim LampState(200), FadingLevel(200)
  972. Dim FlashSpeedUp(200), FlashSpeedDown(200), FlashMin(200), FlashMax(200), FlashLevel(200)
  973. Dim GIoffMult : GIoffMult = 1.55 'Multiplies all non-GI opacity when the GI is off
  974.  
  975. const nrGI = 100    'Gi fade number - 100
  976.  
  977. InitLamps()             ' turn off the lights and flashers and reset them to the default parameters
  978. LampTimer.Interval = -1'40      'lamp fading speed
  979. LampTimer.Enabled = 1
  980.  
  981. ' Lamp & Flasher Timers
  982. dim FrameTime, InitFrameTime : InitFrameTime = 0
  983. Sub LampTimer_Timer()
  984.     FrameTime = gametime - InitFrameTime
  985.     Dim chgLamp, num, chg, ii
  986.     chgLamp = Controller.ChangedLamps
  987.     If Not IsEmpty(chgLamp) Then
  988.         For ii = 0 To UBound(chgLamp)
  989.             LampState(chgLamp(ii, 0) ) = chgLamp(ii, 1)       'keep the real state in an array
  990.            FadingLevel(chgLamp(ii, 0) ) = chgLamp(ii, 1) + 4 'actual fading step
  991.        Next
  992.     End If
  993.     UpdateLamps
  994.  
  995.     FadeEmpty 100
  996.     FadeLUT 100, "ColorGradeBOP_", 7
  997.     FadeGiOff 100
  998.     InitFrameTime = gametime
  999. End Sub
  1000.  
  1001. Sub InitLamps()
  1002.     Dim x
  1003.     For x = 0 to 200
  1004.         LampState(x) = 0         ' current light state, independent of the fading level. 0 is off and 1 is on
  1005.        FadingLevel(x) = 4       ' used to track the fading state
  1006.        'FlashSpeedUp(x) = 0.5    ' faster speed when turning on the flasher
  1007.        'FlashSpeedDown(x) = 0.35 ' slower speed when turning off the flasher
  1008.         FlashSpeedUp(x) = 60     '-1 Timer Fading Speeds (Measured in Total Milliseconds. Lower = Faster.)
  1009.         FlashSpeedDown(x) = 94 
  1010.         FlashMax(x) = 1          ' the maximum value when on, usually 1
  1011.        FlashMin(x) = 0          ' the minimum value when off, usually 0
  1012.        FlashLevel(x) = 0        ' the intensity of the flashers, usually from 0 to 1
  1013.    Next
  1014.     FlashSpeedUp(100) = 100 : FlashSpeedDown(100) = 100 'GI Lut fading speeds
  1015. End Sub
  1016.  
  1017. '***Lamps***
  1018. Sub UpdateLamps()
  1019.     Flash 1, F1 'back wall jackpot
  1020.     Flash 2, F2 'back wall jackpot
  1021.     Flash 3, F3 'back wall jackpot
  1022.     Flash 4, F4 'back wall jackpot
  1023.     Flash 5, F5 'back wall jackpot
  1024.     nFadeL 6, l6
  1025.     nFadeL 7, l7
  1026.     nFadeL 8, l8
  1027.     Flash 9, F9 'skill shot
  1028.     Flash 10, F10 'skill shot
  1029.     Flash 11, F11 'skill shot
  1030.     Flash 12, F12 'skill shot
  1031.     nFadeL 13, l13
  1032.     nFadeL 14, l14
  1033.     nFadeL 15, l15
  1034.     nFadeL 16, l16
  1035.     Flashm 17, F17_FS 'raygun
  1036.     Flash 17, F17_DT 'raygun
  1037.     Flashm 18, F18_FS 'raygun
  1038.     Flash 18, F18_DT 'raygun
  1039.     Flashm 19, F19_FS 'raygun
  1040.     Flash 19, F19_DT 'raygun
  1041.     Flashm 20, F20_DT 'raygun
  1042.     Flash 20, F20_FS 'raygun
  1043.     Flashm 21, F21_FS 'raygun
  1044.     Flash 21, F21_DT 'raygun
  1045.     nFadeLM 17, L17_FS 'raygun
  1046.     nFadeLM 17, L17_DT 'raygun
  1047.     nFadeLM 18, L18_FS 'raygun
  1048.     nFadeLM 18, L18_DT 'raygun
  1049.     nFadeLM 19, L19_FS 'raygun
  1050.     nFadeLM 19, L19_DT 'raygun
  1051.     nFadeLM 20, L20_FS 'raygun
  1052.     nFadeLM 20, L20_DT 'raygun
  1053.     nFadeLM 21, L21_FS 'raygun
  1054.     nFadeLM 21, L21_DT 'raygun
  1055.  
  1056.     nFadeL 22, l22
  1057.     nFadeL 23, l23
  1058.     nFadeL 24, l24
  1059.     nFadeL 25, l25
  1060.     nFadeL 26, l26
  1061.     nFadeL 27, l27
  1062.     nFadeL 28, l28
  1063.     nFadeL 29, l29
  1064.     nFadeL 30, l30
  1065.     nFadeL 31, l31
  1066.     nFadeL 32, l32
  1067.  
  1068.     Flashm 36, F36fs
  1069.     Flashm 36, F36afs
  1070.     Flashm 36, F36dt
  1071.     Flash 36, F36adt
  1072.     Flashm 37, F37dt
  1073.     Flashm 37, F37adt
  1074.     Flashm 37, F37fs
  1075.     Flash 37, F37afs
  1076.     Flashm 38, F38fs
  1077.     Flashm 38, F38DT
  1078.     Flashm 38, F38aDT
  1079.     Flash 38, F38afs
  1080.     nFadeL 39, l39
  1081.     nFadeLm 40, l40b
  1082.     nFadeL 40, l40
  1083.     nFadeL 41, l41
  1084.     nFadeL 42, l42
  1085.     nFadeL 43, l43
  1086.     nFadeL 44, l44
  1087.     nFadeL 45, l45
  1088.     nFadeL 46, l46
  1089.     nFadeL 47, l47
  1090.     nFadeL 48, l48
  1091.     nFadeL 49, l49
  1092.     nFadeL 50, l50
  1093.     nFadeL 51, l51
  1094.     nFadeL 52, l52
  1095.     nFadeL 53, l53
  1096.     nFadeL 54, l54
  1097.     nFadeL 55, l55
  1098.     nFadeL 56, l56
  1099.     Flashm 57, F57fs
  1100.     Flashm 57, F57afs
  1101.     Flashm 57, F57DT
  1102.     Flash 57, F57aDT
  1103.     nFadeL 58, l58
  1104.     nFadeL 59, l59
  1105.     nFadeL 60, l60
  1106.     nFadeL 61, l61
  1107.     nFadeL 62, l62
  1108.     nFadeL 63, l63
  1109.     nFadeL 64, l64
  1110.  
  1111.  
  1112. '***Flashers
  1113.  
  1114.     Flashm 33, F133_FS
  1115.     Flashm 33, F133_DT
  1116.     Flash 33, F133
  1117.     Flashm 34, F134_FS
  1118.     Flashm 34, F134_DT
  1119.     Flash 34, F134
  1120.     Flashm 35, F135_FS
  1121.     Flashm 35, F135_DT
  1122.     Flash 35, F135
  1123.     'NFadeLM 101, L101    'Bully plastic
  1124.     Flash 101, F101
  1125.     nFadeL 125, F33
  1126.  
  1127.     nFadeLm 126, F35
  1128.     nFadeLm 126, F35a
  1129.     nFadeL 126, F35b
  1130.  
  1131.  
  1132.     nFadeLm 127, F34a
  1133.     nFadeLm 127, F34b
  1134.     nFadeL 127, F34
  1135.  
  1136.  
  1137.     'nFadeLM 128, L128   'Magnetic Personality plastic
  1138.     Flash 128, f128
  1139.     Flashm 129, F129
  1140.     Flash 129, F129a
  1141.     'nFadeLm 130, L130 'Heart of Rock and Roll Plastic
  1142.     Flash 130, F130
  1143.     Flash 131, F131
  1144.     Flashm 132, F132_FS
  1145.     Flashm 132, F132_DT
  1146.     Flash 132, F200
  1147. End Sub
  1148.  
  1149.  
  1150. Sub SetLamp(nr, value)
  1151.     If value <> LampState(nr) Then
  1152.         LampState(nr) = abs(value)
  1153.         FadingLevel(nr) = abs(value) + 4
  1154.     End If
  1155. End Sub
  1156.  
  1157. ' Lights: used for VP10 standard lights, the fading is handled by VP itself
  1158.  
  1159. Sub NFadeL(nr, object)
  1160.     Select Case FadingLevel(nr)
  1161.         Case 4:object.state = 0:FadingLevel(nr) = 0
  1162.         Case 5:object.state = 1:FadingLevel(nr) = 1
  1163.     End Select
  1164. End Sub
  1165.  
  1166. Sub NFadeLm(nr, object) ' used for multiple lights
  1167.    Select Case FadingLevel(nr)
  1168.         Case 4:object.state = 0
  1169.         Case 5:object.state = 1
  1170.     End Select
  1171. End Sub
  1172.  
  1173. 'Lights, Ramps & Primitives used as 4 step fading lights
  1174. 'a,b,c,d are the images used from on to off
  1175.  
  1176. Sub FadeObj(nr, object, a, b, c, d)
  1177.     Select Case FadingLevel(nr)
  1178.         Case 4:object.image = b:FadingLevel(nr) = 6                   'fading to off...
  1179.        Case 5:object.image = a:FadingLevel(nr) = 1                   'ON
  1180.        Case 6, 7, 8:FadingLevel(nr) = FadingLevel(nr) + 1            'wait
  1181.        Case 9:object.image = c:FadingLevel(nr) = FadingLevel(nr) + 1 'fading...
  1182.        Case 10, 11, 12:FadingLevel(nr) = FadingLevel(nr) + 1         'wait
  1183.        Case 13:object.image = d:FadingLevel(nr) = 0                  'Off
  1184.    End Select
  1185. End Sub
  1186.  
  1187. Sub FadeObjm(nr, object, a, b, c, d)
  1188.     Select Case FadingLevel(nr)
  1189.         Case 4:object.image = b
  1190.         Case 5:object.image = a
  1191.         Case 9:object.image = c
  1192.         Case 13:object.image = d
  1193.     End Select
  1194. End Sub
  1195.  
  1196. Sub NFadeObj(nr, object, a, b)
  1197.     Select Case FadingLevel(nr)
  1198.         Case 4:object.image = b:FadingLevel(nr) = 0 'off
  1199.        Case 5:object.image = a:FadingLevel(nr) = 1 'on
  1200.    End Select
  1201. End Sub
  1202.  
  1203. Sub NFadeObjm(nr, object, a, b)
  1204.     Select Case FadingLevel(nr)
  1205.         Case 4:object.image = b
  1206.         Case 5:object.image = a
  1207.     End Select
  1208. End Sub
  1209.  
  1210. ' Flasher objects
  1211.  
  1212. Sub Flash(nr, object)
  1213.     Select Case FadingLevel(nr)
  1214.         Case 3
  1215.             FadingLevel(nr) = 0
  1216.         Case 4 'off
  1217.            FlashLevel(nr) = FlashLevel(nr) - (1/FlashSpeedDown(nr) * FrameTime)
  1218.             If FlashLevel(nr) < FlashMin(nr) Then
  1219.                 FlashLevel(nr) = FlashMin(nr)
  1220.                FadingLevel(nr) = 3 'completely off
  1221.            End if
  1222.             Object.IntensityScale = FlashLevel(nr)
  1223.         Case 5 ' on
  1224.            FlashLevel(nr) = FlashLevel(nr) + (1/FlashSpeedUp(nr) * FrameTime)
  1225.             If FlashLevel(nr) > FlashMax(nr) Then
  1226.                 FlashLevel(nr) = FlashMax(nr)
  1227.                 FadingLevel(nr) = 6 'completely on
  1228.            End if
  1229.             Object.IntensityScale = FlashLevel(nr)
  1230.         Case 6
  1231.             FadingLevel(nr) = 1
  1232.     End Select
  1233. End Sub
  1234.  
  1235. Sub Flashm(nr, object) 'multiple flashers, it just sets the flashlevel
  1236.     select case FadingLevel(nr)
  1237.         case 3, 4, 5, 6
  1238.             Object.IntensityScale = FlashLevel(nr)
  1239.     end select
  1240. End Sub
  1241.  
  1242. Sub FadeEmpty(nr)   'Fade a lamp number, no object updates
  1243.    Select Case FadingLevel(nr)
  1244.         Case 3
  1245.             FadingLevel(nr) = 0
  1246.         Case 4 'off
  1247.            FlashLevel(nr) = FlashLevel(nr) - (1/FlashSpeedDown(nr) * FrameTime)
  1248.             If FlashLevel(nr) < FlashMin(nr) Then
  1249.                 FlashLevel(nr) = FlashMin(nr)
  1250.                FadingLevel(nr) = 3 'completely off
  1251.            End if
  1252.             'Object.IntensityScale = FlashLevel(nr)
  1253.        Case 5 ' on
  1254.            FlashLevel(nr) = FlashLevel(nr) + (1/FlashSpeedUp(nr) * FrameTime)
  1255.             If FlashLevel(nr) > FlashMax(nr) Then
  1256.                 FlashLevel(nr) = FlashMax(nr)
  1257.                 FadingLevel(nr) = 6 'completely on
  1258.            End if
  1259.             'Object.IntensityScale = FlashLevel(nr)
  1260.         Case 6
  1261.             FadingLevel(nr) = 1
  1262.     End Select
  1263. End Sub
  1264.  
  1265. Sub FadeLUT(nr, LutName, LutCount)  'fade lookuptable
  1266.     If FadingLevel(nr) > 2 Then
  1267.         dim GoLut : GoLut = cInt(LutCount * FlashLevel(nr)  )+1 '+1 because no 0 with these luts
  1268.         Table1.ColorGradeImage = LutName & GoLut
  1269.         'tbgi2.text = Table1.ColorGradeImage & vbnewline & golut    'debug
  1270.     End If
  1271. End Sub
  1272.  
  1273. Sub FadeGiOff(nr)
  1274.     If FadingLevel(nr) > 2 Then
  1275.         dim GIscale : GiScale = (GIoffMult-1) * (ABS(FlashLevel(nr)-1 )  ) + 1  'invert
  1276.  
  1277.         dim x : for x = 0 to uBound(LightsA)
  1278.             On Error Resume Next
  1279.             LightsA(x).Opacity = LightsB(x) * GIscale
  1280.             LightsA(x).Intensity = LightsB(x) * GIscale
  1281.             LightsA(x).FadeSpeedUp = LightsC(x) * GIscale
  1282.             LightsA(x).FadeSpeedDown = LightsD(x) * GIscale
  1283.             On Error Goto 0
  1284.         Next
  1285.        
  1286.         'Relevant Information
  1287.         'GIoffMult
  1288.         'GILamps, GIFlashers, GI_Lighting
  1289.         'Redim LightsA(999)'    Object references
  1290.         'Redim LightsB(999)'    Opacity / Intensity
  1291.         'Redim LightsC(999)'    Fade Up (Light objects)
  1292.         'Redim LightsD(999)'    Fade Down(Light Objects)
  1293.         'Debug
  1294.         'tbgi.text = "FlashLevel: " & FlashLevel(nr) & vbnewline & _
  1295.         '           "Giscale: "& Giscale & vbnewline & _
  1296.         '           "LightsA(7): "& LightsA(7).Intensity & vbnewline & _
  1297.         '           " "
  1298.     end if
  1299. End Sub
  1300.  
  1301. ' *********************************************************************
  1302. '                      Supporting Ball & Sound Functions
  1303. ' *********************************************************************
  1304.  
  1305. Function Vol(ball) ' Calculates the Volume of the sound based on the ball speed, decrease the default 2000 to hear a louder rolling ball sound
  1306.    Vol = Csng(BallVel(ball) ^2 / 1000)
  1307. End Function
  1308.  
  1309. Function Pan(ball) ' Calculates the pan for a ball based on the X position on the table. "table1" is the name of the table
  1310.    Dim tmp
  1311.     tmp = ball.x * 2 / table1.width-1
  1312.     If tmp> 0 Then
  1313.         Pan = Csng(tmp ^10)
  1314.     Else
  1315.         Pan = Csng(-((- tmp) ^10) )
  1316.     End If
  1317. End Function
  1318.  
  1319. Function Pitch(ball) ' Calculates the pitch of the sound based on the ball speed
  1320.    Pitch = BallVel(ball) * 20
  1321. End Function
  1322.  
  1323. Function BallVel(ball) 'Calculates the ball speed
  1324.    BallVel = INT(SQR((ball.VelX ^2) + (ball.VelY ^2) ) )
  1325. End Function
  1326.  
  1327. '*****************************************
  1328. '    JP's VP10 Rolling Sounds
  1329. '*****************************************
  1330.  
  1331. Const tnob = 3 ' total number of balls
  1332. ReDim rolling(tnob)
  1333. InitRolling
  1334.  
  1335. Sub InitRolling
  1336.     Dim i
  1337.     For i = 0 to tnob
  1338.         rolling(i) = False
  1339.     Next
  1340. End Sub
  1341.  
  1342. Sub RollingSoundsUpdate()
  1343.     Dim BOT, b
  1344.     BOT = GetBalls
  1345.  
  1346.     ' stop the sound of deleted balls
  1347.    For b = UBound(BOT) + 1 to tnob
  1348.         rolling(b) = False
  1349.         StopSound("fx_ballrolling" & b)
  1350.     Next
  1351.  
  1352.     ' exit the sub if no balls on the table
  1353.    If UBound(BOT) = -1 Then Exit Sub
  1354.  
  1355.     ' play the rolling sound for each ball
  1356.    For b = 0 to UBound(BOT)
  1357.         If BallVel(BOT(b) ) > 1 AND BOT(b).z < 30 Then
  1358.             rolling(b) = True
  1359.             PlaySound("fx_ballrolling" & b), -1, Vol(BOT(b) ), Pan(BOT(b) ), 0, Pitch(BOT(b) ), 1, 0
  1360.         Else
  1361.             If rolling(b) = True Then
  1362.                 StopSound("fx_ballrolling" & b)
  1363.                 rolling(b) = False
  1364.             End If
  1365.         End If
  1366.     Next
  1367. End Sub
  1368.  
  1369. '**********************
  1370. ' Ball Collision Sound
  1371. '**********************
  1372.  
  1373. Sub OnBallBallCollision(ball1, ball2, velocity)
  1374.     PlaySound("fx_collide"), 0, Csng(velocity) ^2 / 2000, Pan(ball1), 0, Pitch(ball1), 0, 0
  1375. End Sub
  1376.  
  1377.  
  1378. '*****************************************
  1379. '    JimmyFingers VP10 Sound Routines
  1380. '*****************************************
  1381.  
  1382. '***Metal ramp sounds
  1383. Sub BallHitSound(dummy):PlaySound "fx_balldrop":End Sub
  1384. Sub MetalSound(dummy):PlaySound "fx_metalrolling":End Sub
  1385. Sub LWireStart_Hit():PlaySound "fx_metalrolling": End sub
  1386. Sub RWireStart_Hit():PlaySound "fx_metalrolling":End Sub
  1387. Sub Smallramp_start_Hit():PlaySound "fx_metalrolling":End Sub
  1388. Sub Ramp_drop_Hit(): Playsound "fx_metalhit2" :End Sub
  1389. Sub MMdrop_hit() : PlaySound "fx_balldrop":End Sub
  1390.  
  1391. Sub LWireEnd_Hit()
  1392.      vpmTimer.AddTimer 150, "BallHitSound"
  1393.      StopSound "fx_metalrolling"
  1394.  End Sub
  1395.  
  1396. Sub RWireEnd_Hit()
  1397.      vpmTimer.AddTimer 150, "BallHitSound"
  1398.      StopSound "fx_metalrolling"
  1399.  End Sub
  1400.  
  1401. Sub Smallramp_end_Hit()
  1402.      vpmTimer.AddTimer 150, "BallHitSound"
  1403.      StopSound "fx_metalrolling"
  1404.  End Sub
  1405.  
  1406. Sub RWireEnd1_Hit()
  1407.      vpmTimer.AddTimer 150, "MetalSound"
  1408.      StopSound "fx_vuk_exit2"
  1409.  End Sub
  1410.  
  1411. Sub LRampEnd_Hit()
  1412.      vpmTimer.AddTimer 150, "BallHitSound"
  1413.  End Sub
  1414.  
  1415.  
  1416.  
  1417.  
  1418. '***MISC global. sounds
  1419. Sub RubbersBandsLargeRings_Hit(idx):PlaySound "fx_rubber", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0:End Sub
  1420. Sub RubbersSmallRings_Hit(idx):PlaySound "fx_rubber", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0:End Sub
  1421. Sub Metals_Hit(idx):PlaySound "fx_metalhit2", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0:End Sub
  1422. Sub SpotTargets_Hit(idx):PlaySound "target", 0, Vol(ActiveBall), pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0:End Sub
  1423. Sub LeftFlipper_Collide(parm) : PlaySound "fx_flip_hit1", 0, .9, 0.25 : End Sub
  1424. Sub RightFlipper_Collide(parm) : PlaySound "fx_flip_hit1", 0, .9, 0.25 : End Sub
  1425.  
  1426.  
  1427. '***Flipper hit sounds
  1428. 'Sub LeftFlipper_Collide(parm)
  1429. '   RandomSoundFlipper()
  1430. 'End Sub
  1431. '
  1432. 'Sub RightFlipper_Collide(parm)
  1433. '   RandomSoundFlipper()
  1434. 'End Sub
  1435. '
  1436. 'Sub RandomSoundFlipper()
  1437. '   Select Case Int(Rnd*3)+1
  1438. '       Case 1 : PlaySound "fx_flip_hit1", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
  1439. '       Case 2 : PlaySound "fx_flip_hit2", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
  1440. '       Case 3 : PlaySound "fx_flip_hit3", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
  1441. '   End Select
  1442. 'End Sub
  1443.  
  1444.  
  1445. '**********************************************************************************************************
  1446. 'Digital Display
  1447. '**********************************************************************************************************
  1448.  
  1449. Dim Digits(32)
  1450.  Digits(0)=Array(a00, a05, a0c, a0d, a08, a01, a06, a0f, a02, a03, a04, a07, a0b, a0a, a09, a0e)
  1451.  Digits(1)=Array(a10, a15, a1c, a1d, a18, a11, a16, a1f, a12, a13, a14, a17, a1b, a1a, a19, a1e)
  1452.  Digits(2)=Array(a20, a25, a2c, a2d, a28, a21, a26, a2f, a22, a23, a24, a27, a2b, a2a, a29, a2e)
  1453.  Digits(3)=Array(a30, a35, a3c, a3d, a38, a31, a36, a3f, a32, a33, a34, a37, a3b, a3a, a39, a3e)
  1454.  Digits(4)=Array(a40, a45, a4c, a4d, a48, a41, a46, a4f, a42, a43, a44, a47, a4b, a4a, a49, a4e)
  1455.  Digits(5)=Array(a50, a55, a5c, a5d, a58, a51, a56, a5f, a52, a53, a54, a57, a5b, a5a, a59, a5e)
  1456.  Digits(6)=Array(a60, a65, a6c, a6d, a68, a61, a66, a6f, a62, a63, a64, a67, a6b, a6a, a69, a6e)
  1457.  Digits(7)=Array(a70, a75, a7c, a7d, a78, a71, a76, a7f, a72, a73, a74, a77, a7b, a7a, a79, a7e)
  1458.  Digits(8)=Array(a80, a85, a8c, a8d, a88, a81, a86, a8f, a82, a83, a84, a87, a8b, a8a, a89, a8e)
  1459.  Digits(9)=Array(a90, a95, a9c, a9d, a98, a91, a96, a9f, a92, a93, a94, a97, a9b, a9a, a99, a9e)
  1460.  Digits(10)=Array(aa0, aa5, aac, aad, aa8, aa1, aa6, aaf, aa2, aa3, aa4, aa7, aab, aaa, aa9, aae)
  1461.  Digits(11)=Array(ab0, ab5, abc, abd, ab8, ab1, ab6, abf, ab2, ab3, ab4, ab7, abb, aba, ab9, abe)
  1462.  Digits(12)=Array(ac0, ac5, acc, acd, ac8, ac1, ac6, acf, ac2, ac3, ac4, ac7, acb, aca, ac9, ace)
  1463.  Digits(13)=Array(ad0, ad5, adc, add, ad8, ad1, ad6, adf, ad2, ad3, ad4, ad7, adb, ada, ad9, ade)
  1464.  Digits(14)=Array(ae0, ae5, aec, aed, ae8, ae1, ae6, aef, ae2, ae3, ae4, ae7, aeb, aea, ae9, aee)
  1465.  Digits(15)=Array(af0, af5, afc, afd, af8, af1, af6, aff, af2, af3, af4, af7, afb, afa, af9, afe)
  1466.  
  1467.  Digits(16)=Array(b00, b05, b0c, b0d, b08, b01, b06, b0f, b02, b03, b04, b07, b0b, b0a, b09, b0e)
  1468.  Digits(17)=Array(b10, b15, b1c, b1d, b18, b11, b16, b1f, b12, b13, b14, b17, b1b, b1a, b19, b1e)
  1469.  Digits(18)=Array(b20, b25, b2c, b2d, b28, b21, b26, b2f, b22, b23, b24, b27, b2b, b2a, b29, b2e)
  1470.  Digits(19)=Array(b30, b35, b3c, b3d, b38, b31, b36, b3f, b32, b33, b34, b37, b3b, b3a, b39, b3e)
  1471.  Digits(20)=Array(b40, b45, b4c, b4d, b48, b41, b46, b4f, b42, b43, b44, b47, b4b, b4a, b49, b4e)
  1472.  Digits(21)=Array(b50, b55, b5c, b5d, b58, b51, b56, b5f, b52, b53, b54, b57, b5b, b5a, b59, b5e)
  1473.  Digits(22)=Array(b60, b65, b6c, b6d, b68, b61, b66, b6f, b62, b63, b64, b67, b6b, b6a, b69, b6e)
  1474.  Digits(23)=Array(b70, b75, b7c, b7d, b78, b71, b76, b7f, b72, b73, b74, b77, b7b, b7a, b79, b7e)
  1475.  Digits(24)=Array(b80, b85, b8c, b8d, b88, b81, b86, b8f, b82, b83, b84, b87, b8b, b8a, b89, b8e)
  1476.  Digits(25)=Array(b90, b95, b9c, b9d, b98, b91, b96, b9f, b92, b93, b94, b97, b9b, b9a, b99, b9e)
  1477.  Digits(26)=Array(ba0, ba5, bac, bad, ba8, ba1, ba6, baf, ba2, ba3, ba4, ba7, bab, baa, ba9, bae)
  1478.  Digits(27)=Array(bb0, bb5, bbc, bbd, bb8, bb1, bb6, bbf, bb2, bb3, bb4, bb7, bbb, bba, bb9, bbe)
  1479.  Digits(28)=Array(bc0, bc5, bcc, bcd, bc8, bc1, bc6, bcf, bc2, bc3, bc4, bc7, bcb, bca, bc9, bce)
  1480.  Digits(29)=Array(bd0, bd5, bdc, bdd, bd8, bd1, bd6, bdf, bd2, bd3, bd4, bd7, bdb, bda, bd9, bde)
  1481.  Digits(30)=Array(be0, be5, bec, bed, be8, be1, be6, bef, be2, be3, be4, be7, beb, bea, be9, bee)
  1482.  Digits(31)=Array(bf0, bf5, bfc, bfd, bf8, bf1, bf6, bff, bf2, bf3, bf4, bf7, bfb, bfa, bf9, bfe)
  1483.  
  1484.  Sub DisplayTimer_Timer
  1485.     Dim ChgLED, ii, jj, num, chg, stat, obj, b, x
  1486.     ChgLED=Controller.ChangedLEDs(&Hffffffff, &Hffffffff)
  1487.     If Not IsEmpty(ChgLED)Then
  1488.         If DesktopMode = True Then
  1489.        For ii=0 To UBound(chgLED)
  1490.           num=chgLED(ii, 0) : chg=chgLED(ii, 1) : stat=chgLED(ii, 2)
  1491.             if (num < 32) then
  1492.               For Each obj In Digits(num)
  1493.                    If chg And 1 Then obj.State=stat And 1
  1494.                    chg=chg\2 : stat=stat\2
  1495.                   Next
  1496.             Else
  1497.                    end if
  1498.         Next
  1499.        end if
  1500.     End If
  1501.  End Sub
  1502.  
  1503. '****Prim Guy Shake
  1504. Const PrimGuyShakeXMax=3
  1505. Const PrimGuyShakeXStep=.3
  1506. PrimGuyShakeTimer.Interval = 40
  1507. Dim PrimGuyShakeDirection, PrimGuyShakeXOffset
  1508.  
  1509. Sub PrimGuyShake
  1510.     PrimGuyShakeXOffset = PrimGuyShakeXMax
  1511.     PrimGuy.ObjRotX = PrimGuyShakeXOffset
  1512.     PrimGuyShakeDirection = 1
  1513.     PrimGuyShakeTimer.Enabled = 1
  1514. End Sub
  1515.  
  1516. sub PrimGuyShakeTimer_Timer
  1517.     PrimGuyShakeDirection = -1*PrimGuyShakeDirection    'Change Direction
  1518.     PrimGuyShakeXOffset = PrimGuyShakeXOffset - PrimGuyShakeXStep       'Calc New Offset
  1519.     If PrimGuyShakeXOffset > 0 Then 'Keep Shaking
  1520.         PrimGuy.ObjRotX = PrimGuyShakeDirection * PrimGuyShakeXOffset
  1521.     Else    'Time to stop shaking
  1522.         PrimGuy.ObjRotX  = 0
  1523.         PrimGuyShakeTimer.Enabled = 0
  1524.     End If
  1525. End Sub
  1526.  
  1527.  
  1528. '**********************************************************************************************************
  1529. '**********************************************************************************************************
  1530.  
  1531.  
  1532. 'Generic ramp sounds
  1533. Sub Wall78_Hit:Playsound "metalhit2":End Sub
  1534. Sub Leftlane1_Hit:Playsound "metalhit2":End Sub
  1535. Sub Leftlane2_Hit:Playsound "metalhit2":End Sub
  1536. Sub Wall69_Hit:Playsound "metalhit2":End Sub
  1537.  
  1538.  
  1539.  
  1540.  
  1541. '***Options***
  1542.  
  1543. Dim TableOptions, TableName
  1544. Private vpmShowDips1, vpmDips1
  1545.  
  1546. Sub InitializeOptions
  1547.     TableName="DR_Dude_VPX"                                     'Your descriptive table name, it will be used to save settings in VPReg.stg file
  1548.     Set vpmShowDips1 = vpmShowDips                              'Reassigns vpmShowDips to vpmShowDips1 to allow usage of default dips menu
  1549.     Set vpmShowDips = GetRef("TableShowDips")                   'Assigns new sub to vmpShowDips
  1550.     TableOptions = LoadValue(TableName,"Options")               'Load saved table options
  1551.  
  1552.     Set Controller = CreateObject("VPinMAME.Controller")        'Load vpm controller temporarily so options menu can be loaded if needed
  1553.     If TableOptions = "" Or optReset Then                       'If no existing options, reset to default through optReset, then open Options menu
  1554.         TableOptions = 1                                        'clear any existing settings and set table options to default options
  1555.         TableShowOptions
  1556.     ElseIf (TableOptions And 1) Then                            'If Enable Next Start was selected then
  1557.         'TableOptions = TableOptions - 1                        'clear setting to avoid future executions
  1558.         TableShowOptions
  1559.     Else
  1560.         TableSetOptions
  1561.     End If
  1562.  
  1563.     Set Controller = Nothing                                    'Unload vpm controller so selected controller can be loaded
  1564. End Sub
  1565.  
  1566. Private Sub TableShowDips
  1567.     vpmShowDips1                                                'Show original Dips menu
  1568.     TableShowOptions                                            'Show new options menu
  1569. End Sub
  1570.  
  1571. Private Sub TableShowOptions                    'New options menu
  1572.     Dim oldOptions : oldOptions = TableOptions
  1573.     If Not IsObject(vpmDips1) Then             
  1574.         Set vpmDips1 = New cvpmDips
  1575.         With vpmDips1
  1576.             .AddForm 700, 500, "TABLE OPTIONS MENU"
  1577.             .AddFrameExtra 0,0,155,"Apron Color Mod",2^1+2^2+2^3+2^4, Array("White Apron", 0, "Blue Apron", 2^1, "Green Apron", 2^2, "Custom Apron & Side Walls", 2^3, "Random Apron", 2^4)
  1578.             .AddFrameExtra 0,105,155,"Flipper Style Mod",2^6+2^7, Array("Yellow Flippers", 0, "White Flippers", 2^6, "Random Flippers", 2^7)
  1579.             .AddFrameExtra 0,167,155,"Cheater Post Mod",2^8, Array("No Drain Post", 0, "Add Drain Post", 2^8)
  1580.             .AddFrameExtra 0,217,155,"Excellent Ray Laser Mod", 2^9, Array("Normal", 0, "Show Excellent Ray Laser", 2^9)
  1581.             .AddChkExtra 0,280,155, Array("Enable Menu Next Start", 1)
  1582.         End With
  1583.     End If
  1584.     TableOptions = vpmDips1.ViewDipsExtra(TableOptions)
  1585.     SaveValue TableName,"Options",TableOptions
  1586.     TableSetOptions
  1587.     SetOptions
  1588. End Sub
  1589.  
  1590. Sub TableSetOptions     'defines required settings before table is run
  1591.     Aproncolor = (TableOptions And 2^1+2^2+2^3+2^4)
  1592.         Select Case Aproncolor
  1593.             Case 0: Aproncolor = 0
  1594.             Case 2^1: Aproncolor = 1:
  1595.             Case 2^2: Aproncolor = 2:
  1596.             Case 2^3: Aproncolor = 3:
  1597.             Case 2^4: Aproncolor = 4:
  1598.         End Select
  1599.     Flipperstyle = (TableOptions And 2^6+2^7)
  1600.         Select case Flipperstyle
  1601.             Case 0: Flipperstyle = 0
  1602.             Case 2^6: Flipperstyle = 1
  1603.             Case 2^7: Flipperstyle = 2
  1604.         End select
  1605.     Cheaterpost = (TableOptions And 2^8):If Cheaterpost=2^8 Then:Cheaterpost=1
  1606.     Raybeam = (TableOptions And 2^9): If Raybeam=2^9 Then:Raybeam=1
  1607.  
  1608.     SaveValue TableName,"Options",TableOptions
  1609.     SetOptions
  1610. End Sub
  1611.  
  1612.  
  1613.  
  1614. Sub SetOptions()
  1615.  
  1616.     If Aproncolor = 4 then Aproncolor = Int(Rnd*4) End If    
  1617.     Select Case Aproncolor
  1618.         Case 0 : pApron.image = "apron_texture_White":pApronOverlay.Visible = False:pSidewall_FS.visible = false:pSidewall_DT.visible = false
  1619.         Case 1 : pApron.image = "apron_texture_Blue":pApronOverlay.Visible = False:pSidewall_FS.visible = false:pSidewall_DT.visible = false
  1620.         Case 2 : pApron.image = "apron_texture_Green":pApronOverlay.Visible = False:pSidewall_FS.visible = false:pSidewall_DT.visible = false
  1621.         Case 3 : pApronOverlay.Visible = True:If DesktopMode = True Then pSidewall_DT.visible = True else pSidewall_FS.visible = true End If
  1622.     End Select
  1623.  
  1624.     if flipperstyle = 2 then flipperstyle = int(rnd*2) end if  
  1625.     select case flipperstyle
  1626.         case 0: flipperl.visible=false: flipperr.visible=False: RightFlipper.visible=True: LeftFlipper.visible=true
  1627.         case 1: flipperl.visible=true: flipperr.visible=True: RightFlipper.visible=False: LeftFlipper.visible=false
  1628.     end select
  1629.  
  1630.     If cheaterpost = 1 then
  1631.         Wall41.IsDropped = 0
  1632.         wall41.visible = 1
  1633.         primitive6.visible = 1
  1634.     Else
  1635.         primitive6.Z = -120
  1636.         Wall41.IsDropped = 1
  1637.         wall41.visible = 0
  1638.     End If
  1639.  
  1640.     If Raybeam = 1 then
  1641.          f200.visible = 1
  1642.     Else
  1643.          f200.visible = 0
  1644.     End If
  1645. End Sub
  1646.  
  1647. '*****************************************************************************************************************************************************
  1648. '*****************************************************************************************************************************************************
  1649.  
  1650. 'cFastFlips by nFozzy
  1651. 'Bypasses pinmame callback for faster and more responsive flippers
  1652. 'Version 1.1 beta2 (More proper behaviour, extra safety against script errors)
  1653. '*************************************************
  1654. Function NullFunction(aEnabled):End Function    '1 argument null function placeholder
  1655. Class cFastFlips
  1656.     Public TiltObjects, DebugOn, hi
  1657.     Private SubL, SubUL, SubR, SubUR, FlippersEnabled, Delay, LagCompensation, Name, FlipState(3)
  1658.    
  1659.     Private Sub Class_Initialize()
  1660.         Delay = 0 : FlippersEnabled = False : DebugOn = False : LagCompensation = False
  1661.         Set SubL = GetRef("NullFunction"): Set SubR = GetRef("NullFunction") : Set SubUL = GetRef("NullFunction"): Set SubUR = GetRef("NullFunction")
  1662.     End Sub
  1663.    
  1664.     'set callbacks
  1665.     Public Property Let CallBackL(aInput)  : Set SubL  = GetRef(aInput) : Decouple sLLFlipper, aInput: End Property
  1666.     Public Property Let CallBackUL(aInput) : Set SubUL = GetRef(aInput) : End Property
  1667.     Public Property Let CallBackR(aInput)  : Set SubR  = GetRef(aInput) : Decouple sLRFlipper, aInput:  End Property
  1668.     Public Property Let CallBackUR(aInput) : Set SubUR = GetRef(aInput) : End Property
  1669.     Public Sub InitDelay(aName, aDelay) : Name = aName : delay = aDelay : End Sub   'Create Delay
  1670.     'Automatically decouple flipper solcallback script lines (only if both are pointing to the same sub) thanks gtxjoe
  1671.     Private Sub Decouple(aSolType, aInput)  : If StrComp(SolCallback(aSolType),aInput,1) = 0 then SolCallback(aSolType) = Empty End If : End Sub
  1672.  
  1673.     'call callbacks
  1674.     Public Sub FlipL(aEnabled)
  1675.         FlipState(0) = aEnabled 'track flipper button states: the game-on sol flips immediately if the button is held down (1.1)
  1676.         If not FlippersEnabled and not DebugOn then Exit Sub
  1677.         subL aEnabled
  1678.     End Sub
  1679.  
  1680.     Public Sub FlipR(aEnabled)
  1681.         FlipState(1) = aEnabled
  1682.         If not FlippersEnabled and not DebugOn then Exit Sub
  1683.         subR aEnabled
  1684.     End Sub
  1685.  
  1686.     Public Sub FlipUL(aEnabled)
  1687.         FlipState(2) = aEnabled
  1688.         If not FlippersEnabled and not DebugOn then Exit Sub
  1689.         subUL aEnabled
  1690.     End Sub
  1691.  
  1692.     Public Sub FlipUR(aEnabled)
  1693.         FlipState(3) = aEnabled
  1694.         If not FlippersEnabled and not DebugOn then Exit Sub
  1695.         subUR aEnabled
  1696.     End Sub
  1697.    
  1698.     Public Sub TiltSol(aEnabled)    'Handle solenoid / Delay (if delayinit)
  1699.         If delay > 0 and not aEnabled then  'handle delay
  1700.             vpmtimer.addtimer Delay, Name & ".FireDelay" & "'"
  1701.             LagCompensation = True
  1702.         else
  1703.             If Delay > 0 then LagCompensation = False
  1704.             EnableFlippers(aEnabled)
  1705.         end If
  1706.     End Sub
  1707.    
  1708.     Sub FireDelay() : If LagCompensation then EnableFlippers False End If : End Sub
  1709.    
  1710.     Private Sub EnableFlippers(aEnabled)
  1711.         If aEnabled then SubL FlipState(0) : SubR FlipState(1) : subUL FlipState(2) : subUR FlipState(3)
  1712.         FlippersEnabled = aEnabled
  1713.         If TiltObjects then vpmnudge.solgameon aEnabled
  1714.         If Not aEnabled then
  1715.             subL False
  1716.             subR False
  1717.             If not IsEmpty(subUL) then subUL False
  1718.             If not IsEmpty(subUR) then subUR False
  1719.         End If     
  1720.     End Sub
  1721.    
  1722. End Class
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!