API tools faq
paste
Guest User

Untitled

a guest
Sep 10th, 2017
338
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 23.77 KB | None | 0 0
raw download clone embed print report
  1. Option Explicit
  2. Randomize
  3.  
  4. On Error Resume Next
  5. ExecuteGlobal GetTextFile("controller.vbs")
  6. If Err Then MsgBox "You need the controller.vbs in order to run this table, available in the vp10 package"
  7. On Error Goto 0
  8.  
  9. Const cGameName="genie",UseSolenoids=1,UseLamps=1,UseGI=0,SSolenoidOn="SolOn",SSolenoidOff="SolOff",SFlipperOn="fx_Flipperup",SFlipperOff="fx_Flipperdown"
  10. Const SCoin="coin",cCredits=""
  11.  
  12. LoadVPM"01120100","GTS1.VBS",3.02
  13. Dim DesktopMode: DesktopMode = Table1.ShowDT
  14.  
  15. '*************************************************************
  16.  
  17. 'Solenoid Call backs
  18. '**********************************************************************************************************
  19. SolCallback(1)="bsTrough.SolOut"
  20. SolCallback(2)= "vpmSolSound SoundFX(""Knocker"",DOFKnocker),"
  21. SolCallback(3)= "vpmSolSound SoundFX(""Chime1"",DOFChimes),"
  22. SolCallback(4)= "vpmSolSound SoundFX(""Chime2"",DOFChimes),"
  23. SolCallback(5)= "vpmSolSound SoundFX(""Chime3"",DOFChimes),"
  24. SolCallback(6)= "bsSaucer.SolOut"
  25. SolCallback(7)= "dtDrop1.SolDropUp"
  26. SolCallback(8)= "dtDrop2.SolDropUp"
  27. SolCallback(17)="vpmNudge.SolGameOn"
  28. 'SolCallback(sLLFlipper)="vpmSolFlipper LeftFlipper,LeftFlipper1,"
  29. 'SolCallback(sLRFlipper)="RightFliper"
  30.  
  31. SolCallback(sLRFlipper) = "SolRFlipper"
  32. SolCallback(sLLFlipper) = "SolLFlipper"
  33.  
  34. Sub SolLFlipper(Enabled)
  35. If Enabled Then
  36. PlaySound SoundFX("FlipperUp",DOFFlippers):LeftFlipper.RotateToEnd:LeftFlipper1.RotateToEnd
  37. Else
  38. PlaySound SoundFX("FlipperDown",DOFFlippers):LeftFlipper.RotateToStart:LeftFlipper1.RotateToStart
  39. End If
  40. End Sub
  41.  
  42. Sub SolRFlipper(Enabled)
  43. If Enabled Then
  44. PlaySound SoundFX("FlipperUp",DOFFlippers):RightFlipper.RotateToEnd:RightFlipper1.RotateToEnd:RightFlipper2.RotateToEnd
  45. Else
  46. PlaySound SoundFX("FlipperDown",DOFFlippers):RightFlipper.RotateToStart:RightFlipper1.RotateToStart:RightFlipper2.RotateToStart
  47. End If
  48. End Sub
  49.  
  50. 'Sub RightFliper(Enabled)
  51. ' If Enabled Then
  52. ' VpmSolFlipper RightFlipper,RightFlipper1,True
  53. ' RightFlipper2.RotateToEnd
  54. ' Else
  55. ' VpmSolFlipper RightFlipper,RightFlipper1,False
  56. ' RightFlipper2.RotateToStart
  57. ' End If
  58. 'End Sub
  59. '**********************************************************************************************************
  60.  
  61. 'Initiate Table
  62. '**********************************************************************************************************
  63. Dim bsTrough,dtDrop1,dtDrop2,bsSaucer
  64.  
  65. Sub Table1_Init
  66. vpmInit Me
  67. On Error Resume Next
  68. With Controller
  69. .GameName = cGameName
  70. If Err Then MsgBox "Can't start Game" & cGameName & vbNewLine & Err.Description : Exit Sub
  71. .SplashInfoLine="Genie (Gottlieb)"&chr(13)&"You Suck"
  72. .HandleMechanics=0
  73. .HandleKeyboard=0
  74. .ShowDMDOnly=1
  75. .ShowFrame=0
  76. .ShowTitle=0
  77. .hidden = 1
  78. If Err Then MsgBox Err.Description
  79. End With
  80. On Error Goto 0
  81. Controller.SolMask(0)=0
  82. vpmTimer.AddTimer 2000,"Controller.SolMask(0)=&Hffffffff'" 'ignore all solenoids - then add the timer to renable all the solenoids after 2 seconds
  83. Controller.Run
  84. If Err Then MsgBox Err.Description
  85. On Error Goto 0
  86.  
  87. PinMAMETimer.Interval=PinMAMEInterval
  88. PinMAMETimer.Enabled=1
  89. vpmNudge.TiltSwitch=4
  90. vpmNudge.Sensitivity=3
  91. vpmNudge.TiltObj=Array(Bumper1,Bumper2,Bumper3)
  92.  
  93. Set bsTrough = New cvpmBallStack
  94. bsTrough.initnotrough BallExit, 66, 60, 14
  95. bsTrough.InitExitSnd SoundFX("ballrelease",DOFContactors),SoundFX("ballrelease",DOFContactors)
  96.  
  97. Set bsSaucer=New cvpmBallstack
  98. bsSaucer.InitSaucer TopHole,41,235,6
  99. bsSaucer.InitExitSnd SoundFX("HoleKick",DOFContactors),SoundFX("SolOn",DOFContactors)
  100.  
  101. Set dtDrop1=New cvpmDropTarget
  102. dtDrop1.InitDrop Array(sw20,sw21,sw23,sw24),Array(20,21,23,24)
  103. dtDrop1.InitSnd SoundFX("DTDrop",DOFDropTargets),SoundFX("DTReset",DOFContactors)
  104.  
  105. Set dtDrop2=New cvpmDropTarget
  106. dtDrop2.InitDrop Array(sw30,sw70,sw31,sw71,sw60,sw74,sw61),Array(30,70,31,71,60,74,61)
  107. dtDrop2.InitSnd SoundFX("DTDrop",DOFDropTargets),SoundFX("DTReset",DOFContactors)
  108. End Sub
  109. '**********************************************************************************************************
  110. 'Plunger code
  111. '**********************************************************************************************************
  112. Sub Table1_KeyDown(ByVal keycode)
  113. If vpmKeyDown(KeyCode) Then Exit Sub
  114. If keycode=PlungerKey Then Plunger.Pullback:playsound"plungerpull"
  115. End Sub
  116.  
  117. Sub Table1_KeyUp(ByVal keycode)
  118. If vpmKeyUp(KeyCode) Then Exit Sub
  119. If keycode=PlungerKey Then Plunger.Fire:playsound"plunger"
  120. End Sub
  121.  
  122. '***********************************************************
  123. '**** Rollover Wire Trigger CODE ****
  124. '***********************************************************
  125. Sub SW10A_Hit:Controller.Switch(10)=1 : playsound"rollover" : DOF 103, DOFOn : End Sub
  126. Sub SW10A_UnHit:Controller.Switch(10)=0: DOF 103, DOFOff : End Sub
  127. Sub SW11A_Hit:Controller.Switch(11)=1 : playsound"rollover" : DOF 105, DOFOn : End Sub
  128. Sub SW11A_UnHit:Controller.Switch(11)=0: DOF 105, DOFOff : End Sub
  129. Sub SW13A_Hit:Controller.Switch(13)=1 : playsound"rollover" : DOF 107, DOFOn : End Sub
  130. Sub SW13A_UnHit:Controller.Switch(13)=0: DOF 107, DOFOff : End Sub
  131. Sub SW14A_Hit:Controller.Switch(14)=1 : playsound"rollover" : DOF 109, DOFOn : End Sub
  132. Sub SW14A_UnHit:Controller.Switch(14)=0: DOF 109, DOFOff : End Sub
  133.  
  134. Sub SW10B_Hit:Controller.Switch(10)=1 : playsound"rollover" : DOF 104, DOFOn : End Sub
  135. Sub SW10B_UnHit:Controller.Switch(10)=0:DOF 104, DOFOff :End Sub
  136. Sub SW11B_Hit:Controller.Switch(11)=1 : playsound"rollover" : DOF 106, DOFOn : End Sub
  137. Sub SW11B_UnHit:Controller.Switch(11)=0:DOF 106, DOFOff :End Sub
  138. Sub SW13B_Hit:Controller.Switch(13)=1 : playsound"rollover" : DOF 108, DOFOn :End Sub
  139. Sub SW13B_UnHit:Controller.Switch(13)=0:DOF 108, DOFOff :End Sub
  140. Sub SW14B_Hit:Controller.Switch(14)=1 : playsound"rollover" : DOF 110, DOFOn : End Sub
  141. Sub SW14B_UnHit:Controller.Switch(14)=0:DOF 110, DOFOff :End Sub
  142.  
  143. Sub SW54A_Hit:Controller.Switch(54)=1 : playsound"rollover" : DOF 115, DOFOn :End Sub
  144. Sub SW54A_UnHit:Controller.Switch(54)=0:DOF 115, DOFOff :End Sub
  145. Sub SW54B_Hit:Controller.Switch(54)=1 : playsound"rollover" : DOF 116, DOFOn :End Sub
  146. Sub SW54B_UnHit:Controller.Switch(54)=0:DOF 116, DOFOff :End Sub
  147.  
  148. Sub SW63A_Hit:Controller.Switch(63)=1 : playsound"rollover" : DOF 112, DOFOn :End Sub
  149. Sub SW63A_UnHit:Controller.Switch(63)=0:DOF 112, DOFOff :End Sub
  150. Sub SW63B_Hit:Controller.Switch(63)=1 : playsound"rollover" : DOF 113, DOFOn :End Sub
  151. Sub SW63B_UnHit:Controller.Switch(63)=0:DOF 113, DOFOff :End Sub
  152. Sub SW63C_Hit:Controller.Switch(63)=1 : playsound"rollover" : DOF 114, DOFOn :End Sub
  153. Sub SW63C_UnHit:Controller.Switch(63)=0:DOF 114, DOFOff :End Sub
  154.  
  155. Sub SW73A_Hit:Controller.Switch(73)=1 : playsound"rollover" : DOF 117, DOFOn :End Sub
  156. Sub SW73A_UnHit:Controller.Switch(73)=0:DOF 117, DOFOff :End Sub
  157. Sub SW73B_Hit:Controller.Switch(73)=1 : playsound"rollover" : DOF 118, DOFOn :End Sub
  158. Sub SW73B_UnHit:Controller.Switch(73)=0:DOF 118, DOFOff :End Sub
  159.  
  160. '***********************************************************
  161. '**** Star SWITCH CODE ****
  162. '***********************************************************
  163. Sub SW53A_Hit:Controller.Switch(53)=1 : playsound"rollover" : DOF 122, DOFOn :End Sub
  164. Sub SW53A_UnHit:Controller.Switch(53)=0:DOF 122, DOFOff :End Sub
  165. Sub SW53B_Hit:Controller.Switch(53)=1 : playsound"rollover" : DOF 123, DOFOn :End Sub
  166. Sub SW53B_UnHit:Controller.Switch(53)=0:DOF 123, DOFOff :End Sub
  167. Sub SW53C_Hit:Controller.Switch(53)=1 : playsound"rollover" : DOF 124, DOFOn :End Sub
  168. Sub SW53C_UnHit:Controller.Switch(53)=0:DOF 124, DOFOff :End Sub
  169. Sub SW64A_Hit:Controller.Switch(64)=1 : playsound"rollover" : DOF 119, DOFOn :End Sub
  170. Sub SW64A_UnHit:Controller.Switch(64)=0:DOF 119, DOFOff :End Sub
  171. Sub SW64B_Hit:Controller.Switch(64)=1 : playsound"rollover" : DOF 120, DOFOn :End Sub
  172. Sub SW64B_UnHit:Controller.Switch(64)=0:DOF 120, DOFOff :End Sub
  173.  
  174. '***********************************************************
  175. '**** SPINNER CODE ****
  176. '***********************************************************
  177. Sub SW33_Spin:vpmTimer.PulseSw 33 : playsound"fx_spinner" : End Sub
  178.  
  179. '***********************************************************
  180. '**** STAND UP TARGET CODE ****
  181. '***********************************************************
  182. Sub SW40_Hit:vpmTimer.PulseSw 40 : End Sub
  183. Sub SW44_Hit:vpmTimer.PulseSw 44 : End Sub
  184. Sub SW51_Hit:vpmTimer.PulseSw 51 : End Sub
  185. Sub SW63_Hit:vpmTimer.PulseSw 63 : DOF 111, DOFPulse : End Sub
  186.  
  187. '***********************************************************
  188. '**** SAUCER CODE ****
  189. '***********************************************************
  190. Sub TopHole_Hit():bsSaucer.Addball 0:End Sub
  191. Sub Drain_Hit:playsound"drain":bsTrough.addball me:End Sub
  192.  
  193. '***********************************************************
  194. '**** SLING CODE ****
  195. '***********************************************************
  196. 'Non animated Slingshots
  197. Sub sw50a_Hit:vpmTimer.PulseSw 50 : playsound"slingshot": End Sub
  198. Sub sw50d_Hit:vpmTimer.PulseSw 50 : playsound"slingshot" : End Sub
  199. Sub SW50e_Hit:vpmTimer.PulseSw 50 : playsound"slingshot" : End Sub
  200. Sub SW50f_Hit:vpmTimer.PulseSw 50 : playsound"slingshot" : End Sub
  201. Sub sw50g_Hit:vpmTimer.PulseSw 50 : playsound"slingshot" : End Sub
  202. Sub sw50h_Hit:vpmTimer.PulseSw 50 : playsound"slingshot" : End Sub
  203. Sub sw50i_Hit:vpmTimer.PulseSw 50 : playsound"slingshot" : End Sub
  204.  
  205. '***********************************************************
  206. '**** DROP TARGET CODE ****
  207. '***********************************************************
  208. Sub Sw20_Hit: dtDrop1.Hit 1: End Sub
  209. Sub Sw21_Hit: dtDrop1.Hit 2: End Sub
  210. Sub Sw23_Hit: dtDrop1.Hit 3: End Sub
  211. Sub Sw24_Hit: dtDrop1.Hit 4: End Sub
  212.  
  213.  
  214. Sub Sw30_Hit: dtDrop2.Hit 1: End Sub
  215. Sub Sw70_Hit: dtDrop2.Hit 2: End Sub
  216. Sub Sw31_Hit: dtDrop2.Hit 3: End Sub
  217. Sub Sw71_Hit: dtDrop2.Hit 4: End Sub
  218. Sub Sw60_Hit: dtDrop2.Hit 5: End Sub
  219. Sub Sw61_Hit: dtDrop2.Hit 6: End Sub
  220. Sub Sw74_Hit: dtDrop2.Hit 7: End Sub
  221.  
  222.  
  223. '***********************************************************
  224. '**** BUMPER CODE ****
  225. '***********************************************************
  226. Sub Bumper1_Hit : vpmTimer.PulseSw(43) : playsound SoundFX("fx_bumper1",DOFContactors): End Sub
  227. Sub Bumper2_Hit : vpmTimer.PulseSw(53) : playsound SoundFXDOF("fx_bumper1",101,DOFPulse,DOFContactors): End Sub
  228. Sub Bumper3_Hit : vpmTimer.PulseSw(53) : playsound SoundFXDOF("fx_bumper1",102,DOFPulse,DOFContactors): End Sub
  229.  
  230. '******************************************************************************
  231. 'Primitive Flipper Code
  232. Sub FlipperTimer_Timer
  233. FlipperT1.roty = LeftFlipper.currentangle + 90
  234. FlipperT5.roty = RightFlipper.currentangle + 90
  235. FlipperT2.roty = RightFlipper1.currentangle + 90
  236. End Sub
  237. '******************************************************************************
  238.  
  239. '**********************************************************************************************************
  240.  
  241. 'Map lights to an array
  242. '**********************************************************************************************************
  243.  
  244. Set Lights(4) = l4p ' Shoot Again Playfied and backglass
  245. Set Lights(5) = l5
  246. Set Lights(6) = l6
  247. Set Lights(7) = l7
  248. Set Lights(8) = l8
  249. Set Lights(9) = l9
  250. Set Lights(10) = l10
  251. Set Lights(11) = l11
  252. Set Lights(12) = l12
  253. Set Lights(13) = l13
  254. Set Lights(14) = l14
  255. Set Lights(15) = l15
  256. Set Lights(16) = l16
  257. Set Lights(17) = l17
  258. Set Lights(18) = l18
  259. Set Lights(19) = l19
  260. Set Lights(20) = l20
  261. Set Lights(21) = l21
  262. Set Lights(22) = l22
  263. Set Lights(23) = l23
  264. Set Lights(24) = l24
  265. Set Lights(25) = l25
  266. Set Lights(26) = l26
  267. Set Lights(27) = l27
  268. Set Lights(28) = l28
  269. Set Lights(29) = l29
  270. Set Lights(30) = l30
  271. Set Lights(31) = l31
  272. Set Lights(32) = l32
  273. Set Lights(33) = l33
  274. Set Lights(36) = l36
  275. Set Lights(150) = Light1 'Star Trigger 1
  276. Set Lights(151) = Light2 'Star Trigger 2
  277. Set Lights(152) = Light3 'Star Trigger 3
  278. Set Lights(153) = Light4 'Star Trigger 4
  279. Set Lights(154) = Light5 'Star Trigger 5
  280.  
  281. 'Backglass
  282. 'Set Lights(1) = l1 'High Score
  283. 'Set Lights(2) = l2 'Tilt
  284. 'Set Lights(3) = l3 'High Score
  285. '**********************************************************************************************************
  286. ' Backglass Light Displays (7 digit 7 segment displays)
  287. Dim Digits(32)
  288. Digits(0)=Array(a00,a01,a02,a03,a04,a05,a06,n,a08)
  289. Digits(1)=Array(a10,a11,a12,a13,a14,a15,a16,n,a18)
  290. Digits(2)=Array(a20,a21,a22,a23,a24,a25,a26,n,a28)
  291. Digits(3)=Array(a30,a31,a32,a33,a34,a35,a36,n,a38)
  292. Digits(4)=Array(a40,a41,a42,a43,a44,a45,a46,n,a48)
  293. Digits(5)=Array(a50,a51,a52,a53,a54,a55,a56,n,a58)
  294. Digits(6)=Array(b00,b01,b02,b03,b04,b05,b06,n,b08)
  295. Digits(7)=Array(b10,b11,b12,b13,b14,b15,b16,n,b18)
  296. Digits(8)=Array(b20,b21,b22,b23,b24,b25,b26,n,b28)
  297. Digits(9)=Array(b30,b31,b32,b33,b34,b35,b36,n,b38)
  298. Digits(10)=Array(b40,b41,b42,b43,b44,b45,b46,n,b48)
  299. Digits(11)=Array(b50,b51,b52,b53,b54,b55,b56,n,b58)
  300. Digits(12)=Array(c00,c01,c02,c03,c04,c05,c06,n,c08)
  301. Digits(13)=Array(c10,c11,c12,c13,c14,c15,c16,n,c18)
  302. Digits(14)=Array(c20,c21,c22,c23,c24,c25,c26,n,c28)
  303. Digits(15)=Array(c30,c31,c32,c33,c34,c35,c36,n,c38)
  304. Digits(16)=Array(c40,c41,c42,c43,c44,c45,c46,n,c48)
  305. Digits(17)=Array(c50,c51,c52,c53,c54,c55,c56,n,c58)
  306. Digits(18)=Array(d00,d01,d02,d03,d04,d05,d06,n,d08)
  307. Digits(19)=Array(d10,d11,d12,d13,d14,d15,d16,n,d18)
  308. Digits(20)=Array(d20,d21,d22,d23,d24,d25,d26,n,d28)
  309. Digits(21)=Array(d30,d31,d32,d33,d34,d35,d36,n,d38)
  310. Digits(22)=Array(d40,d41,d42,d43,d44,d45,d46,n,d48)
  311. Digits(23)=Array(d50,d51,d52,d53,d54,d55,d56,n,d58)
  312. Digits(24)=Array(e00,e01,e02,e03,e04,e05,e06,n,e08)
  313. Digits(25)=Array(e10,e11,e12,e13,e14,e15,e16,n,e18)
  314. Digits(26)=Array(f00,f01,f02,f03,f04,f05,f06,n,f08)
  315. Digits(27)=Array(f10,f11,f12,f13,f14,f15,f16,n,f18)
  316.  
  317.  
  318. Sub DisplayTimer_Timer
  319. Dim ChgLED,ii,num,chg,stat,obj
  320. ChgLed = Controller.ChangedLEDs(&Hffffffff, &Hffffffff)
  321. If Not IsEmpty(ChgLED) Then
  322. If DesktopMode = True Then
  323. For ii = 0 To UBound(chgLED)
  324. num = chgLED(ii, 0) : chg = chgLED(ii, 1) : stat = chgLED(ii, 2)
  325. if (num < 32) then
  326. For Each obj In Digits(num)
  327. If chg And 1 Then obj.State = stat And 1
  328. chg = chg\2 : stat = stat\2
  329. Next
  330. else
  331. 'if char(stat) > "" then msg(num) = char(stat)
  332. end if
  333. next
  334. end if
  335. end if
  336. End Sub
  337.  
  338. '**********************************************************************************************************
  339. Sub editDips
  340. Dim vpmDips : Set vpmDips = New cvpmDips
  341. With vpmDips
  342. .AddForm 700,400,"System 1 (Multi-Mode sound) - DIP switches"
  343. .AddFrame 0,0,190,"Coin chute control",&H00040000,Array("seperate",0,"same",&H00040000)'dip 19
  344. .AddFrame 0,46,190,"Game mode",&H00000400,Array("extra ball",0,"replay",&H00000400)'dip 11
  345. .AddFrame 0,92,190,"High game to date awards",&H00200000,Array("no award",0,"3 replays",&H00200000)'dip 22
  346. .AddFrame 0,138,190,"Balls per game",&H00000100,Array("5 balls",0,"3 balls",&H00000100)'dip 9
  347. .AddFrame 0,184,190,"Tilt effect",&H00000800,Array("game over",0,"ball in play only",&H00000800)'dip 12
  348. .AddFrame 205,0,190,"Maximum credits",&H00030000,Array("5 credits",0,"8 credits",&H00020000,"10 credits",&H00010000,"15 credits",&H00030000)'dip 17&18
  349. .AddFrame 205,76,190,"Sound settings",&H80000000,Array("sounds",0,"tones",&H80000000)'dip 32
  350. .AddFrame 205,122,190,"Attract tune",&H10000000,Array("no attract tune",0,"attract tune played every 6 minutes",&H10000000)'dip 29
  351. .AddChk 205,175,190,Array("Match feature",&H00000200)'dip 10
  352. .AddChk 205,190,190,Array("Credits displayed",&H00001000)'dip 13
  353. .AddChk 205,205,190,Array("Play credit button tune",&H00002000)'dip 14
  354. .AddChk 205,220,190,Array("Play tones when scoring",&H00080000)'dip 20
  355. .AddChk 205,235,190,Array("Play coin switch tune",&H00400000)'dip 23
  356. .AddChk 205,250,190,Array("High game to date displayed",&H00100000)'dip 21
  357. .AddLabel 50,280,300,20,"After hitting OK, press F3 to reset game with new settings."
  358. .ViewDips
  359. End With
  360. End Sub
  361. Set vpmShowDips = GetRef("editDips")
  362.  
  363. '**********************************************************************************************************
  364. '**********************************************************************************************************
  365. '**********************************************************************************************************
  366.  
  367. 'VPX Functions
  368. '**********************************************************************************************************
  369. '**********************************************************************************************************
  370.  
  371.  
  372. '*****GI Lights On
  373. dim xx
  374.  
  375. For each xx in GI:xx.State = 1: Next
  376.  
  377. '**********Sling Shot Animations
  378. ' Rstep and Lstep are the variables that increment the animation
  379. '****************
  380. Dim RStep, Lstep
  381.  
  382. Sub RightSlingShot_Slingshot
  383. vpmTimer.PulseSw 50
  384. PlaySound "left_slingshot", 0, 1, 0.05, 0.05
  385. 'RSling.Visible = 0
  386. 'RSling1.Visible = 1
  387. 'sling1.TransZ = -20
  388. 'RStep = 0
  389. 'RightSlingShot.TimerEnabled = 1
  390. End Sub
  391.  
  392. Sub RightSlingShot_Timer
  393. Select Case RStep
  394. Case 3:RSLing1.Visible = 0:RSLing2.Visible = 1:sling1.TransZ = -10
  395. Case 4:RSLing2.Visible = 0:RSLing.Visible = 1:sling1.TransZ = 0:RightSlingShot.TimerEnabled = 0:
  396. End Select
  397. RStep = RStep + 1
  398. End Sub
  399.  
  400. Sub LeftSlingShot_Slingshot
  401. vpmTimer.PulseSw 50
  402. PlaySound SoundFXDOF("right_slingshot",121,DOFPulse,DOFcontactors),0,1,-0.05,0.05
  403. LSling.Visible = 0
  404. LSling1.Visible = 1
  405. sling2.TransZ = -20
  406. LStep = 0
  407. LeftSlingShot.TimerEnabled = 1
  408. End Sub
  409.  
  410. Sub LeftSlingShot_Timer
  411. Select Case LStep
  412. Case 3:LSLing1.Visible = 0:LSLing2.Visible = 1:sling2.TransZ = -10
  413. Case 4:LSLing2.Visible = 0:LSLing.Visible = 1:sling2.TransZ = 0:LeftSlingShot.TimerEnabled = 0:
  414. End Select
  415. LStep = LStep + 1
  416. End Sub
  417.  
  418.  
  419.  
  420. ' *********************************************************************
  421. ' Supporting Ball & Sound Functions
  422. ' *********************************************************************
  423.  
  424. Function Vol(ball) ' Calculates the Volume of the sound based on the ball speed
  425. Vol = Csng(BallVel(ball) ^2 / 2000)
  426. End Function
  427.  
  428. Function Pan(ball) ' Calculates the pan for a ball based on the X position on the table. "table1" is the name of the table
  429. Dim tmp
  430. tmp = ball.x * 2 / table1.width-1
  431. If tmp > 0 Then
  432. Pan = Csng(tmp ^10)
  433. Else
  434. Pan = Csng(-((- tmp) ^10) )
  435. End If
  436. End Function
  437.  
  438. Function Pitch(ball) ' Calculates the pitch of the sound based on the ball speed
  439. Pitch = BallVel(ball) * 20
  440. End Function
  441.  
  442. Function BallVel(ball) 'Calculates the ball speed
  443. BallVel = INT(SQR((ball.VelX ^2) + (ball.VelY ^2) ) )
  444. End Function
  445.  
  446. '*****************************************
  447. ' JP's VP10 Rolling Sounds
  448. '*****************************************
  449.  
  450. Const tnob = 5 ' total number of balls
  451. ReDim rolling(tnob)
  452. InitRolling
  453.  
  454. Sub InitRolling
  455. Dim i
  456. For i = 0 to tnob
  457. rolling(i) = False
  458. Next
  459. End Sub
  460.  
  461. Sub RollingTimer_Timer()
  462. Dim BOT, b
  463. BOT = GetBalls
  464.  
  465. ' stop the sound of deleted balls
  466. For b = UBound(BOT) + 1 to tnob
  467. rolling(b) = False
  468. StopSound("fx_ballrolling" & b)
  469. Next
  470.  
  471. ' exit the sub if no balls on the table
  472. If UBound(BOT) = -1 Then Exit Sub
  473.  
  474. ' play the rolling sound for each ball
  475. For b = 0 to UBound(BOT)
  476. If BallVel(BOT(b) ) > 1 AND BOT(b).z < 30 Then
  477. rolling(b) = True
  478. PlaySound("fx_ballrolling" & b), -1, Vol(BOT(b) ), Pan(BOT(b) ), 0, Pitch(BOT(b) ), 1, 0
  479. Else
  480. If rolling(b) = True Then
  481. StopSound("fx_ballrolling" & b)
  482. rolling(b) = False
  483. End If
  484. End If
  485. Next
  486. End Sub
  487.  
  488. '**********************
  489. ' Ball Collision Sound
  490. '**********************
  491.  
  492. Sub OnBallBallCollision(ball1, ball2, velocity)
  493. PlaySound("fx_collide"), 0, Csng(velocity) ^2 / 2000, Pan(ball1), 0, Pitch(ball1), 0, 0
  494. End Sub
  495.  
  496.  
  497.  
  498. '************************************
  499. ' What you need to add to your table
  500. '************************************
  501.  
  502. ' a timer called RollingTimer. With a fast interval, like 10
  503. ' one collision sound, in this script is called fx_collide
  504. ' as many sound files as max number of balls, with names ending with 0, 1, 2, 3, etc
  505. ' for ex. as used in this script: fx_ballrolling0, fx_ballrolling1, fx_ballrolling2, fx_ballrolling3, etc
  506.  
  507.  
  508. '******************************************
  509. ' Explanation of the rolling sound routine
  510. '******************************************
  511.  
  512. ' sounds are played based on the ball speed and position
  513.  
  514. ' the routine checks first for deleted balls and stops the rolling sound.
  515.  
  516. ' The For loop goes through all the balls on the table and checks for the ball speed and
  517. ' if the ball is on the table (height lower than 30) then then it plays the sound
  518. ' otherwise the sound is stopped, like when the ball has stopped or is on a ramp or flying.
  519.  
  520. ' The sound is played using the VOL, PAN and PITCH functions, so the volume and pitch of the sound
  521. ' will change according to the ball speed, and the PAN function will change the stereo position according
  522. ' to the position of the ball on the table.
  523.  
  524.  
  525. '**************************************
  526. ' Explanation of the collision routine
  527. '**************************************
  528.  
  529. ' The collision is built in VP.
  530. ' You only need to add a Sub OnBallBallCollision(ball1, ball2, velocity) and when two balls collide they
  531. ' will call this routine. What you add in the sub is up to you. As an example is a simple Playsound with volume and paning
  532. ' depending of the speed of the collision.
  533.  
  534.  
  535. Sub Pins_Hit (idx)
  536. PlaySound "pinhit_low", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0
  537. End Sub
  538.  
  539. Sub Targets_Hit (idx)
  540. PlaySound "target", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0
  541. End Sub
  542.  
  543. Sub Metals_Thin_Hit (idx)
  544. PlaySound "metalhit_thin", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
  545. End Sub
  546.  
  547. Sub Metals_Medium_Hit (idx)
  548. PlaySound "metalhit_medium", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
  549. End Sub
  550.  
  551. Sub Metals2_Hit (idx)
  552. PlaySound "metalhit2", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
  553. End Sub
  554.  
  555. Sub Gates_Hit (idx)
  556. PlaySound "gate4", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
  557. End Sub
  558.  
  559. Sub Spinner_Spin
  560. PlaySound "fx_spinner",0,.25,0,0.25
  561. End Sub
  562.  
  563. Sub Rubbers_Hit(idx)
  564. dim finalspeed
  565. finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
  566. If finalspeed > 20 then
  567. PlaySound "fx_rubber2", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
  568. End if
  569. If finalspeed >= 6 AND finalspeed <= 20 then
  570. RandomSoundRubber()
  571. End If
  572. End Sub
  573.  
  574. Sub Posts_Hit(idx)
  575. dim finalspeed
  576. finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
  577. If finalspeed > 16 then
  578. PlaySound "fx_rubber2", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
  579. End if
  580. If finalspeed >= 6 AND finalspeed <= 16 then
  581. RandomSoundRubber()
  582. End If
  583. End Sub
  584.  
  585. Sub RandomSoundRubber()
  586. Select Case Int(Rnd*3)+1
  587. Case 1 : PlaySound "rubber_hit_1", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
  588. Case 2 : PlaySound "rubber_hit_2", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
  589. Case 3 : PlaySound "rubber_hit_3", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
  590. End Select
  591. End Sub
  592.  
  593. Sub LeftFlipper_Collide(parm)
  594. RandomSoundFlipper()
  595. End Sub
  596.  
  597. Sub RightFlipper_Collide(parm)
  598. RandomSoundFlipper()
  599. End Sub
  600.  
  601. Sub RandomSoundFlipper()
  602. Select Case Int(Rnd*3)+1
  603. Case 1 : PlaySound "flip_hit_1", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
  604. Case 2 : PlaySound "flip_hit_2", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
  605. Case 3 : PlaySound "flip_hit_3", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
  606. End Select
  607. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
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!