Guest User

Untitled

a guest
Apr 7th, 2019
97
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  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="granny",UseSolenoids=1,UseLamps=0,UseGI=0,SSolenoidOn="SolOn",SSolenoidOff="SolOff", SCoin="coin"
  10.  
  11. LoadVPM "01560000", "BALLY.VBS", 3.26
  12. Dim DesktopMode: DesktopMode = Table1.ShowDT
  13.  
  14. 'if Desktop hide Backpannel primitive
  15. If DesktopMode = True Then
  16. Primitive17.Visible = 0
  17. else
  18. Primitive17.Visible = 1
  19. End if
  20.  
  21.  
  22. '*************************************************************
  23. 'Solenoid Call backs
  24. '**********************************************************************************************************
  25. SolCallback(1)="bsTrough.SolOut"
  26. SolCallback(2)="dtDrop.SolDropUp"
  27. SolCallback(3)="bsSaucer2.SolOut"
  28. SolCallback(4)="bsSaucer.SolOut"
  29.  
  30. SolCallback(8)="Flippers"
  31.  
  32. Sub Flippers(Enabled)
  33. If Enabled Then
  34. FlipperOn=1
  35. Else
  36. FlipperOn=0
  37. If LS=1 Then LeftFlipper.RotateToStart
  38. If RS=1 Then RightFlipper.RotateToStart
  39. If LS=1 Or RS=1 Then
  40. PlaySound SoundFX("fx_Flipperdown",DOFContactors)
  41. LS=0
  42. RS=0
  43. End If
  44. End If
  45. End Sub
  46.  
  47. Sub SetDisplayToElement(Element)
  48. If Controller.Version<="01500000" Then
  49. ' forget it, version is to old
  50. Exit Sub
  51. End If
  52. Dim playerRect
  53. playerRect=Controller.GetClientRect(GetPlayerHwnd)
  54. Dim playerWidth, playerHeight
  55. playerWidth=playerRect(2)-playerRect(0)
  56. playerHeight=playerRect(3)-playerRect(1)
  57. Dim Game
  58. Set Game=Controller.Game
  59. Dim x,y
  60. x=Element.x*playerWidth/1000.0-1
  61. y=Element.y*playerHeight/750.0-1
  62. Game.Settings.SetDisplayPosition x,y,GetPlayerHwnd
  63. Set Game=nothing
  64. End Sub
  65.  
  66.  
  67. '**********************************************************************************************************
  68.  
  69. 'Solenoid Controlled toys
  70. '**********************************************************************************************************
  71.  
  72.  
  73. '*****GI Lights On
  74. dim xx
  75. For each xx in GI:xx.State = 1: Next
  76.  
  77.  
  78. '**********************************************************************************************************
  79.  
  80. 'Initiate Table
  81. '**********************************************************************************************************
  82.  
  83. Dim bsTrough, bsSaucer, bsSaucer2, dtDrop, FlipperOn, LS, RS, mHole
  84. FlipperOn=0:LS=0:RS=0
  85.  
  86. Sub Table1_Init
  87. vpmInit Me
  88. On Error Resume Next
  89. With Controller
  90. .GameName = cGameName
  91. If Err Then MsgBox "Can't start Game" & cGameName & vbNewLine & Err.Description : Exit Sub
  92. .SplashInfoLine = "Granny and the Gators"&chr(13)&"You Suck"
  93. .HandleMechanics=0
  94. .HandleKeyboard=0
  95. .ShowDMDOnly=1
  96. .ShowFrame=0
  97. .ShowTitle=0
  98. .hidden = 0
  99. On Error Resume Next
  100. .Run GetPlayerHWnd
  101. If Err Then MsgBox Err.Description
  102. On Error Goto 0
  103. End With
  104. On Error Goto 0
  105.  
  106. vpmNudge.TiltSwitch=15
  107. vpmNudge.Sensitivity=2
  108.  
  109. PinMAMETimer.Interval=PinMAMEInterval
  110. PinMAMETimer.Enabled=1
  111.  
  112. Set bsTrough=New cvpmBallStack
  113. bsTrough.InitSaucer Drain,18,345,18
  114. bsTrough.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)
  115. bsTrough.AddBall 0
  116. Drain.CreateBall
  117.  
  118. Set bsSaucer=New cvpmBallStack
  119. bsSaucer.InitSaucer sw25,25,167,8
  120. bsSaucer.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)
  121.  
  122. Set bsSaucer2=New cvpmBallStack
  123. bsSaucer2.InitSaucer sw26,26,0,14
  124. bsSaucer2.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)
  125.  
  126. Set dtDrop=New cvpmDropTarget
  127. dtDrop.InitDrop Array(Sw37,Sw38,Sw39,Sw40,Sw24),Array(37,38,39,40,24)
  128. dtDrop.InitSnd SoundFX("DTDrop",DOFContactors),SoundFX("DTReset",DOFContactors)
  129.  
  130. Set mHole = New cvpmMagnet
  131. mHole.InitMagnet Umagnet, 3
  132. mHole.GrabCenter = 0
  133. mHole.MagnetOn = 1
  134. mHole.CreateEvents "mHole"
  135.  
  136. End Sub
  137.  
  138. '**********************************************************************************************************
  139. 'Key Code including rempaing to joystick buttons
  140. '**********************************************************************************************************
  141.  
  142.  
  143. ExtraKeyHelp=KeyName(StartGameKey)&vbTab&"1 Player Start+Fire"&vbNewLine&_
  144. KeyName(KeyFront)&vbTab&"2 Player Start+Fire"&vbNewLine&_
  145. KeyName(KeyJoyLeft)&vbTab&"Left Paddle"&vbNewLine&_
  146. KeyName(KeyJoyRight)&vbTab&"Right Paddle"&vbNewLine&_
  147. KeyName(KeyJoyUp)&vbTab&"Power Paddle"&vbNewLine&_
  148. KeyName(KeyJoyDown)&vbTab&"Fire"
  149.  
  150. Sub Table1_KeyDown(ByVal KeyCode)
  151. If keycode= 6 then vpmTimer.pulseSW (swCoin3) ' Map the 5 key to add credit
  152. If KeyCode=StartGameKey Then Controller.Switch(-1)=1
  153. If KeyCode=KeyFront Then Controller.Switch(0)=1
  154. If KeyCode=KeyJoyLeft Then Controller.Switch(-2)=1
  155. If KeyCode=KeyJoyRight Then Controller.Switch(-3)=1
  156. If KeyCode=KeyJoyUp Then Controller.Switch(41)=1
  157. If KeyCode=KeyJoyDown Then Controller.Switch(-1)=1
  158. If KeyCode=LeftFlipperKey Then
  159. If FlipperOn=1 And LS=0 Then
  160. LeftFlipper.RotateToEnd
  161. PlaySound SoundFX("fx_Flipperup",DOFContactors)
  162. LS=1
  163. End If
  164. End If
  165. If KeyCode=RightFlipperKey Then
  166. If FlipperOn=1 And RS=0 Then
  167. RightFlipper.RotateToEnd
  168. PlaySound SoundFX("fx_Flipperup",DOFContactors)
  169. RS=1
  170. End If
  171. End If
  172. If vpmKeyDown(KeyCode) Then Exit Sub
  173. End Sub
  174.  
  175. Sub Table1_KeyUp(ByVal KeyCode)
  176. If KeyCode=StartGameKey Then Controller.Switch(-1)=0
  177. If KeyCode=KeyFront Then Controller.Switch(0)=0
  178. If KeyCode=KeyJoyLeft Then Controller.Switch(-2)=0
  179. If KeyCode=KeyJoyRight Then Controller.Switch(-3)=0
  180. If KeyCode=KeyJoyUp Then Controller.Switch(41)=0
  181. If KeyCode=KeyJoyDown Then Controller.Switch(-1)=0
  182. If KeyCode=LeftFlipperKey And LS=1 Then
  183. LeftFlipper.RotateToStart
  184. PlaySound SoundFX("fx_Flipperdown",DOFContactors)
  185. LS=0
  186. End If
  187. If KeyCode=RightFlipperKey And RS=1 Then
  188. RightFlipper.RotateToStart
  189. PlaySound SoundFX("fx_Flipperdown",DOFContactors)
  190. RS=0
  191. End If
  192. If vpmKeyUp(KeyCode) Then Exit Sub
  193. End Sub
  194.  
  195. '**********************************************************************************************************
  196.  
  197. ' Drain hole and kickers
  198. Sub Drain_Hit:bsTrough.AddBall 0 : playsound"drain" : End Sub
  199. Sub sw25_Hit:bsSaucer.AddBall 0 : playsound "popper_ball": End Sub
  200. Sub sw26_Hit:bsSaucer2.AddBall 0 : playsound "popper_ball": End Sub
  201.  
  202. 'Drop Targets
  203. Sub Sw37_Dropped:dtDrop.Hit 1 :End Sub
  204. Sub Sw38_Dropped:dtDrop.Hit 2 :End Sub
  205. Sub Sw39_Dropped:dtDrop.Hit 3 :End Sub
  206. Sub Sw40_Dropped:dtDrop.Hit 4 :End Sub
  207. Sub Sw24_Dropped:dtDrop.Hit 5 :End Sub
  208.  
  209. 'Star Triggers
  210. Sub SW1_Hit:Controller.Switch(1)=1 : playsound"rollover" : End Sub
  211. Sub SW1_unHit:Controller.Switch(1)=0:End Sub
  212. Sub SW2_Hit:Controller.Switch(2)=1 : playsound"rollover" : End Sub
  213. Sub SW2_unHit:Controller.Switch(2)=0:End Sub
  214. Sub SW3_Hit:Controller.Switch(3)=1 : playsound"rollover" : End Sub
  215. Sub SW3_unHit:Controller.Switch(3)=0:End Sub
  216. Sub SW4_Hit:Controller.Switch(4)=1 : playsound"rollover" : End Sub
  217. Sub SW4_unHit:Controller.Switch(4)=0:End Sub
  218. Sub SW5_Hit:Controller.Switch(5)=1 : playsound"rollover" : End Sub
  219. Sub SW5_unHit:Controller.Switch(5)=0:End Sub
  220. Sub SW6_Hit:Controller.Switch(6)=1 : playsound"rollover" : End Sub
  221. Sub SW6_unHit:Controller.Switch(6)=0:End Sub
  222. Sub SW7_Hit:Controller.Switch(7)=1 : playsound"rollover" : End Sub
  223. Sub SW7_unHit:Controller.Switch(7)=0:End Sub
  224. Sub SW8_Hit:Controller.Switch(8)=1 : playsound"rollover" : End Sub
  225. Sub SW8_unHit:Controller.Switch(8)=0:End Sub
  226. Sub SW21_Hit:Controller.Switch(21)=1 : playsound"rollover" : End Sub
  227. Sub SW21_unHit:Controller.Switch(21)=0:End Sub
  228. Sub SW21a_Hit:Controller.Switch(21)=1 : playsound"rollover" : End Sub
  229. Sub SW21a_unHit:Controller.Switch(21)=0:End Sub
  230.  
  231. 'Gate Trigger
  232. Sub sw19_hit:vpmTimer.pulseSw 19 : End Sub
  233.  
  234. 'Wire Triggers
  235. Sub SW22_Hit:Controller.Switch(22)=1 : playsound"rollover" : End Sub
  236. Sub SW22_unHit:Controller.Switch(22)=0:End Sub
  237. Sub SW23_Hit:Controller.Switch(23)=1 : playsound"rollover" : End Sub
  238. Sub SW23_unHit:Controller.Switch(23)=0:End Sub
  239.  
  240. 'Stand Up Targets
  241. Sub sw29_hit:vpmTimer.pulseSw 29 : End Sub
  242. Sub sw30_hit:vpmTimer.pulseSw 30 : End Sub
  243. Sub sw31_hit:vpmTimer.pulseSw 31 : End Sub
  244. Sub sw32_hit:vpmTimer.pulseSw 32 : End Sub
  245. Sub sw33_hit:vpmTimer.pulseSw 33 : End Sub
  246. Sub sw34_hit:vpmTimer.pulseSw 34 : End Sub
  247. Sub sw35_hit:vpmTimer.pulseSw 35 : End Sub
  248. Sub sw36_hit:vpmTimer.pulseSw 36 : End Sub
  249.  
  250.  
  251. '***************************************************
  252. ' JP's VP10 Fading Lamps & Flashers
  253. ' Based on PD's Fading Light System
  254. ' SetLamp 0 is Off
  255. ' SetLamp 1 is On
  256. ' fading for non opacity objects is 4 steps
  257. '***************************************************
  258.  
  259. Dim LampState(200), FadingLevel(200)
  260. Dim FlashSpeedUp(200), FlashSpeedDown(200), FlashMin(200), FlashMax(200), FlashLevel(200)
  261.  
  262. InitLamps() ' turn off the lights and flashers and reset them to the default parameters
  263. LampTimer.Interval = 5 'lamp fading speed
  264. LampTimer.Enabled = 1
  265.  
  266. ' Lamp & Flasher Timers
  267.  
  268. Sub LampTimer_Timer()
  269. Dim chgLamp, num, chg, ii
  270. chgLamp = Controller.ChangedLamps
  271. If Not IsEmpty(chgLamp) Then
  272. For ii = 0 To UBound(chgLamp)
  273. LampState(chgLamp(ii, 0) ) = chgLamp(ii, 1) 'keep the real state in an array
  274. FadingLevel(chgLamp(ii, 0) ) = chgLamp(ii, 1) + 4 'actual fading step
  275. Next
  276. End If
  277. UpdateLamps
  278. End Sub
  279.  
  280.  
  281. Sub UpdateLamps
  282. NFadeL 1, l1
  283. NFadeL 2, l2
  284. NFadeL 3, l3
  285. NFadeLm 4, l4 'lower left panel
  286. NFadeL 4, l4a 'lower right panel
  287. NFadeL 5, l5
  288. NFadeL 6, l6
  289. NFadeL 7, l7 'lower center panel
  290. NFadeL 8, l8
  291. NFadeL 9, l9
  292. NFadeL 10, l10
  293. NFadeL 17, l17
  294. NFadeL 18, l18
  295. NFadeL 19, l19
  296. NFadeL 20, l20
  297. NFadeL 21, l21
  298. NFadeL 22, l22
  299. NFadeL 23, l23
  300. NFadeL 24, l24
  301. NFadeL 25, l25
  302. NFadeL 26, l26
  303. NFadeL 33, l33
  304. NFadeL 34, l34
  305. NFadeL 35, l35
  306. NFadeL 37, l37
  307. NFadeL 38, l38
  308. NFadeL 39, l39
  309. NFadeL 40, l40
  310. NFadeL 41, l41
  311. NFadeL 42, l42
  312. NFadeL 49, l49
  313. NFadeL 50, l50
  314. NFadeL 51, l51
  315. NFadeLm 52, l52
  316. NFadeL 52, l52a
  317. NFadeL 53, l53
  318. NFadeL 54, l54
  319. NFadeL 55, l55
  320. NFadeL 56, l56
  321. NFadeL 57, l57
  322. NFadeL 58, l58
  323. End Sub
  324.  
  325.  
  326.  
  327. ' div lamp subs
  328.  
  329. Sub InitLamps()
  330. Dim x
  331. For x = 0 to 200
  332. LampState(x) = 0 ' current light state, independent of the fading level. 0 is off and 1 is on
  333. FadingLevel(x) = 4 ' used to track the fading state
  334. FlashSpeedUp(x) = 0.4 ' faster speed when turning on the flasher
  335. FlashSpeedDown(x) = 0.2 ' slower speed when turning off the flasher
  336. FlashMax(x) = 1 ' the maximum value when on, usually 1
  337. FlashMin(x) = 0 ' the minimum value when off, usually 0
  338. FlashLevel(x) = 0 ' the intensity of the flashers, usually from 0 to 1
  339. Next
  340. End Sub
  341.  
  342. Sub AllLampsOff
  343. Dim x
  344. For x = 0 to 200
  345. SetLamp x, 0
  346. Next
  347. End Sub
  348.  
  349. Sub SetLamp(nr, value)
  350. If value <> LampState(nr) Then
  351. LampState(nr) = abs(value)
  352. FadingLevel(nr) = abs(value) + 4
  353. End If
  354. End Sub
  355.  
  356. ' Lights: used for VP10 standard lights, the fading is handled by VP itself
  357.  
  358. Sub NFadeL(nr, object)
  359. Select Case FadingLevel(nr)
  360. Case 4:object.state = 0:FadingLevel(nr) = 0
  361. Case 5:object.state = 1:FadingLevel(nr) = 1
  362. End Select
  363. End Sub
  364.  
  365. Sub NFadeLm(nr, object) ' used for multiple lights
  366. Select Case FadingLevel(nr)
  367. Case 4:object.state = 0
  368. Case 5:object.state = 1
  369. End Select
  370. End Sub
  371.  
  372. 'Lights, Ramps & Primitives used as 4 step fading lights
  373. 'a,b,c,d are the images used from on to off
  374.  
  375. Sub FadeObj(nr, object, a, b, c, d)
  376. Select Case FadingLevel(nr)
  377. Case 4:object.image = b:FadingLevel(nr) = 6 'fading to off...
  378. Case 5:object.image = a:FadingLevel(nr) = 1 'ON
  379. Case 6, 7, 8:FadingLevel(nr) = FadingLevel(nr) + 1 'wait
  380. Case 9:object.image = c:FadingLevel(nr) = FadingLevel(nr) + 1 'fading...
  381. Case 10, 11, 12:FadingLevel(nr) = FadingLevel(nr) + 1 'wait
  382. Case 13:object.image = d:FadingLevel(nr) = 0 'Off
  383. End Select
  384. End Sub
  385.  
  386. Sub FadeObjm(nr, object, a, b, c, d)
  387. Select Case FadingLevel(nr)
  388. Case 4:object.image = b
  389. Case 5:object.image = a
  390. Case 9:object.image = c
  391. Case 13:object.image = d
  392. End Select
  393. End Sub
  394.  
  395. Sub NFadeObj(nr, object, a, b)
  396. Select Case FadingLevel(nr)
  397. Case 4:object.image = b:FadingLevel(nr) = 0 'off
  398. Case 5:object.image = a:FadingLevel(nr) = 1 'on
  399. End Select
  400. End Sub
  401.  
  402. Sub NFadeObjm(nr, object, a, b)
  403. Select Case FadingLevel(nr)
  404. Case 4:object.image = b
  405. Case 5:object.image = a
  406. End Select
  407. End Sub
  408.  
  409. ' Flasher objects
  410.  
  411. Sub Flash(nr, object)
  412. Select Case FadingLevel(nr)
  413. Case 4 'off
  414. FlashLevel(nr) = FlashLevel(nr) - FlashSpeedDown(nr)
  415. If FlashLevel(nr) < FlashMin(nr) Then
  416. FlashLevel(nr) = FlashMin(nr)
  417. FadingLevel(nr) = 0 'completely off
  418. End if
  419. Object.IntensityScale = FlashLevel(nr)
  420. Case 5 ' on
  421. FlashLevel(nr) = FlashLevel(nr) + FlashSpeedUp(nr)
  422. If FlashLevel(nr) > FlashMax(nr) Then
  423. FlashLevel(nr) = FlashMax(nr)
  424. FadingLevel(nr) = 1 'completely on
  425. End if
  426. Object.IntensityScale = FlashLevel(nr)
  427. End Select
  428. End Sub
  429.  
  430. Sub Flashm(nr, object) 'multiple flashers, it just sets the flashlevel
  431. Object.IntensityScale = FlashLevel(nr)
  432. End Sub
  433.  
  434. 'Reels
  435. Sub FadeReel(nr, reel)
  436. Select Case FadingLevel(nr)
  437. Case 2:FadingLevel(nr) = 0
  438. Case 3:FadingLevel(nr) = 2
  439. Case 4:reel.Visible = 0:FadingLevel(nr) = 3
  440. Case 5:reel.Visible = 1:FadingLevel(nr) = 1
  441. End Select
  442. End Sub
  443.  
  444. 'Inverted Reels
  445. Sub FadeIReel(nr, reel)
  446. Select Case FadingLevel(nr)
  447. Case 2:FadingLevel(nr) = 0
  448. Case 3:FadingLevel(nr) = 2
  449. Case 4:reel.Visible = 1:FadingLevel(nr) = 3
  450. Case 5:reel.Visible = 0:FadingLevel(nr) = 1
  451. End Select
  452. End Sub
  453.  
  454.  
  455. 'Bally Granny and the Gators
  456. 'added by Inkochnito
  457. Sub editDips
  458. Dim vpmDips : Set vpmDips = New cvpmDips
  459. With vpmDips
  460. .AddForm 700,400,"Granny and the Gators - DIP switches"
  461. .AddFrame 0,0,190,"Canoes per game",&HC0000000,Array("2 canoes",&HC0000000,"3 canoes",0,"4 canoes",&H80000000,"5 canoes",&H40000000)'dip 31&32
  462. .AddFrame 0,76,190,"Center hoop shot flashes",&H00000020,Array("long",0,"short",&H00000020)'dip 6
  463. .AddFrame 0,122,190,"Exit to video light will come on for",&H00800000,Array("paddle power",0,"next canoe",&H00800000)'dip 24
  464. .AddFrame 0,168,190,"Game mode",&H20000000,Array("normal",0,"free play",&H20000000)'dip 30
  465. .AddChk 0,220,190,Array("Credits displayed",&H04000000)'dip 27
  466. .AddChk 0,235,190,Array("Center rollover lights in memory",&H00000080)'dip 8
  467. .AddChk 0,250,190,Array("Extra canoe light in memory",&H00004000)'dip 15
  468. .AddLabel 0,270,200,15,"Set 'High score mode' to 03"
  469. .AddLabel 0,285,200,15,"(press 7) for the best gameplay."
  470. .AddLabel 0,305,200,15,"After hitting OK, press F3 to"
  471. .AddLabel 0,320,200,15,"reset game with new settings."
  472. .ViewDips
  473. End With
  474. End Sub
  475. Set vpmShowDips = GetRef("editDips")
  476.  
  477. '*********************************************************************
  478. ' Positional Sound Playback Functions
  479. '*********************************************************************
  480.  
  481. ' Play a sound, depending on the X,Y position of the table element (especially cool for surround speaker setups, otherwise stereo panning only)
  482. ' parameters (defaults): loopcount (1), volume (1), randompitch (0), pitch (0), useexisting (0), restart (1))
  483. ' Note that this will not work (currently) for walls/slingshots as these do not feature a simple, single X,Y position
  484. Sub PlayXYSound(soundname, tableobj, loopcount, volume, randompitch, pitch, useexisting, restart)
  485. PlaySound soundname, loopcount, volume, AudioPan(tableobj), randompitch, pitch, useexisting, restart, AudioFade(tableobj)
  486. End Sub
  487.  
  488. ' Similar subroutines that are less complicated to use (e.g. simply use standard parameters for the PlaySound call)
  489. Sub PlaySoundAt(soundname, tableobj)
  490. PlaySound soundname, 1, 1, AudioPan(tableobj), 0,0,0, 1, AudioFade(tableobj)
  491. End Sub
  492.  
  493. Sub PlaySoundAtBall(soundname)
  494. PlaySoundAt soundname, ActiveBall
  495. End Sub
  496.  
  497.  
  498. '*********************************************************************
  499. ' Supporting Ball & Sound Functions
  500. '*********************************************************************
  501.  
  502. Function AudioFade(tableobj) ' Fades between front and back of the table (for surround systems or 2x2 speakers, etc), depending on the Y position on the table. "table1" is the name of the table
  503. Dim tmp
  504. tmp = tableobj.y * 2 / table1.height-1
  505. If tmp > 0 Then
  506. AudioFade = Csng(tmp ^10)
  507. Else
  508. AudioFade = Csng(-((- tmp) ^10) )
  509. End If
  510. End Function
  511.  
  512. Function AudioPan(tableobj) ' Calculates the pan for a tableobj based on the X position on the table. "table1" is the name of the table
  513. Dim tmp
  514. tmp = tableobj.x * 2 / table1.width-1
  515. If tmp > 0 Then
  516. AudioPan = Csng(tmp ^10)
  517. Else
  518. AudioPan = Csng(-((- tmp) ^10) )
  519. End If
  520. End Function
  521.  
  522. Function Vol(ball) ' Calculates the Volume of the sound based on the ball speed
  523. Vol = Csng(BallVel(ball) ^2 / 2000)
  524. End Function
  525.  
  526. Function Pitch(ball) ' Calculates the pitch of the sound based on the ball speed
  527. Pitch = BallVel(ball) * 20
  528. End Function
  529.  
  530. Function BallVel(ball) 'Calculates the ball speed
  531. BallVel = INT(SQR((ball.VelX ^2) + (ball.VelY ^2) ) )
  532. End Function
  533.  
  534. '*****************************************
  535. ' JP's VP10 Rolling Sounds
  536. '*****************************************
  537.  
  538. Const tnob = 5 ' total number of balls
  539. ReDim rolling(tnob)
  540. InitRolling
  541.  
  542. Sub InitRolling
  543. Dim i
  544. For i = 0 to tnob
  545. rolling(i) = False
  546. Next
  547. End Sub
  548.  
  549. Sub RollingTimer_Timer()
  550. Dim BOT, b
  551. BOT = GetBalls
  552.  
  553. ' stop the sound of deleted balls
  554. For b = UBound(BOT) + 1 to tnob
  555. rolling(b) = False
  556. StopSound("fx_ballrolling" & b)
  557. Next
  558.  
  559. ' exit the sub if no balls on the table
  560. If UBound(BOT) = -1 Then Exit Sub
  561.  
  562. ' play the rolling sound for each ball
  563. For b = 0 to UBound(BOT)
  564. If BallVel(BOT(b) ) > 1 AND BOT(b).z < 30 Then
  565. rolling(b) = True
  566. PlaySound("fx_ballrolling" & b), -1, Vol(BOT(b)), AudioPan(BOT(b)), 0, Pitch(BOT(b)), 1, 0, AudioFade(BOT(b))
  567. Else
  568. If rolling(b) = True Then
  569. StopSound("fx_ballrolling" & b)
  570. rolling(b) = False
  571. End If
  572. End If
  573. Next
  574. End Sub
  575.  
  576. '**********************
  577. ' Ball Collision Sound
  578. '**********************
  579.  
  580. Sub OnBallBallCollision(ball1, ball2, velocity)
  581. PlaySound("fx_collide"), 0, Csng(velocity) ^2 / 2000, AudioPan(ball1), 0, Pitch(ball1), 0, 0, AudioFade(ball1)
  582. End Sub
  583.  
  584.  
  585. '*****************************************
  586. ' ninuzzu's FLIPPER SHADOWS
  587. '*****************************************
  588.  
  589. sub FlipperTimer_Timer()
  590. FlipperLSh.RotZ = LeftFlipper.currentangle
  591. FlipperRSh.RotZ = RightFlipper.currentangle
  592.  
  593. End Sub
  594.  
  595. '*****************************************
  596. ' ninuzzu's BALL SHADOW
  597. '*****************************************
  598. Dim BallShadow
  599. BallShadow = Array (BallShadow1,BallShadow2,BallShadow3,BallShadow4,BallShadow5)
  600.  
  601. Sub BallShadowUpdate_timer()
  602. Dim BOT, b
  603. BOT = GetBalls
  604. ' hide shadow of deleted balls
  605. If UBound(BOT)<(tnob-1) Then
  606. For b = (UBound(BOT) + 1) to (tnob-1)
  607. BallShadow(b).visible = 0
  608. Next
  609. End If
  610. ' exit the Sub if no balls on the table
  611. If UBound(BOT) = -1 Then Exit Sub
  612. ' render the shadow for each ball
  613. For b = 0 to UBound(BOT)
  614. If BOT(b).X < Table1.Width/2 Then
  615. BallShadow(b).X = ((BOT(b).X) - (Ballsize/6) + ((BOT(b).X - (Table1.Width/2))/7)) + 6
  616. Else
  617. BallShadow(b).X = ((BOT(b).X) + (Ballsize/6) + ((BOT(b).X - (Table1.Width/2))/7)) - 6
  618. End If
  619. ballShadow(b).Y = BOT(b).Y + 12
  620. If BOT(b).Z > 20 Then
  621. BallShadow(b).visible = 1
  622. Else
  623. BallShadow(b).visible = 0
  624. End If
  625. Next
  626. End Sub
  627.  
  628.  
  629.  
  630. '************************************
  631. ' What you need to add to your table
  632. '************************************
  633.  
  634. ' a timer called RollingTimer. With a fast interval, like 10
  635. ' one collision sound, in this script is called fx_collide
  636. ' as many sound files as max number of balls, with names ending with 0, 1, 2, 3, etc
  637. ' for ex. as used in this script: fx_ballrolling0, fx_ballrolling1, fx_ballrolling2, fx_ballrolling3, etc
  638.  
  639.  
  640. '******************************************
  641. ' Explanation of the rolling sound routine
  642. '******************************************
  643.  
  644. ' sounds are played based on the ball speed and position
  645.  
  646. ' the routine checks first for deleted balls and stops the rolling sound.
  647.  
  648. ' The For loop goes through all the balls on the table and checks for the ball speed and
  649. ' if the ball is on the table (height lower than 30) then then it plays the sound
  650. ' otherwise the sound is stopped, like when the ball has stopped or is on a ramp or flying.
  651.  
  652. ' The sound is played using the VOL, AUDIOPAN, AUDIOFADE and PITCH functions, so the volume and pitch of the sound
  653. ' will change according to the ball speed, and the AUDIOPAN & AUDIOFADE functions will change the stereo position
  654. ' according to the position of the ball on the table.
  655.  
  656.  
  657. '**************************************
  658. ' Explanation of the collision routine
  659. '**************************************
  660.  
  661. ' The collision is built in VP.
  662. ' You only need to add a Sub OnBallBallCollision(ball1, ball2, velocity) and when two balls collide they
  663. ' 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
  664. ' depending of the speed of the collision.
  665.  
  666.  
  667. Sub Pins_Hit (idx)
  668. PlaySound "pinhit_low", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall)
  669. End Sub
  670.  
  671. Sub Targets_Hit (idx)
  672. PlaySound "target", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall)
  673. End Sub
  674.  
  675. Sub Metals_Thin_Hit (idx)
  676. PlaySound "metalhit_thin", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  677. End Sub
  678.  
  679. Sub Metals_Medium_Hit (idx)
  680. PlaySound "metalhit_medium", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  681. End Sub
  682.  
  683. Sub Metals2_Hit (idx)
  684. PlaySound "metalhit2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  685. End Sub
  686.  
  687. Sub Gates_Hit (idx)
  688. PlaySound "gate4", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  689. End Sub
  690.  
  691. Sub Spinner_Spin
  692. PlaySound "fx_spinner", 0, .25, AudioPan(Spinner), 0.25, 0, 0, 1, AudioFade(Spinner)
  693. End Sub
  694.  
  695. Sub Rubbers_Hit(idx)
  696. dim finalspeed
  697. finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
  698. If finalspeed > 20 then
  699. PlaySound "fx_rubber2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  700. End if
  701. If finalspeed >= 6 AND finalspeed <= 20 then
  702. RandomSoundRubber()
  703. End If
  704. End Sub
  705.  
  706. Sub Posts_Hit(idx)
  707. dim finalspeed
  708. finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
  709. If finalspeed > 16 then
  710. PlaySound "fx_rubber2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  711. End if
  712. If finalspeed >= 6 AND finalspeed <= 16 then
  713. RandomSoundRubber()
  714. End If
  715. End Sub
  716.  
  717. Sub RandomSoundRubber()
  718. Select Case Int(Rnd*3)+1
  719. Case 1 : PlaySound "rubber_hit_1", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  720. Case 2 : PlaySound "rubber_hit_2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  721. Case 3 : PlaySound "rubber_hit_3", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  722. End Select
  723. End Sub
  724.  
  725. Sub LeftFlipper_Collide(parm)
  726. RandomSoundFlipper()
  727. End Sub
  728.  
  729. Sub RightFlipper_Collide(parm)
  730. RandomSoundFlipper()
  731. End Sub
  732.  
  733. Sub RandomSoundFlipper()
  734. Select Case Int(Rnd*3)+1
  735. Case 1 : PlaySound "flip_hit_1", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  736. Case 2 : PlaySound "flip_hit_2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  737. Case 3 : PlaySound "flip_hit_3", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  738. End Select
  739. End Sub
RAW Paste Data