Advertisement
Guest User

Untitled

a guest
Jul 16th, 2018
132
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 31.97 KB | None | 0 0
  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="tagteam2",UseSolenoids=1,UseLamps=0,UseGI=0,SSolenoidOn="SolOn",SSolenoidOff="SolOff", SCoin="coin"
  10.  
  11. LoadVPM "01210000","sys80.vbs",3.10
  12.  
  13. Dim DesktopMode: DesktopMode = Table1.ShowDT
  14. If DesktopMode = True Then 'Show Desktop components
  15. Ramp16.visible=1
  16. Ramp15.visible=1
  17. Primitive13.visible=1
  18. Else
  19. Ramp16.visible=0
  20. Ramp15.visible=0
  21. Primitive13.visible=0
  22. End if
  23.  
  24. '*************************************************************
  25. 'Solenoid Call backs
  26. '**********************************************************************************************************
  27. SolCallback(1)= "bsSaucer.SolOut"
  28. SolCallback(2)= "bsSaucer2.SolOut"
  29. SolCallback(5)= "dtL.SolDropUp" 'Drop Targets
  30. SolCallback(6)= "dtR.SolDropUp" 'Drop Targets
  31. SolCallback(8)= "vpmSolSound SoundFX(""Knocker"",DOFKnocker),"
  32. SolCallback(9)= "bsTrough.SolIn"
  33.  
  34. SolCallback(sLRFlipper) = "SolRFlipper"
  35. SolCallback(sLLFlipper) = "SolLFlipper"
  36.  
  37. Sub SolLFlipper(Enabled)
  38. If Enabled Then
  39. PlaySound SoundFX("fx_Flipperup",DOFContactors):LeftFlipper.RotateToEnd:Flipper1.RotateToEnd
  40. Else
  41. PlaySound SoundFX("fx_Flipperdown",DOFContactors):LeftFlipper.RotateToStart:Flipper1.RotateToStart
  42. End If
  43. End Sub
  44.  
  45. Sub SolRFlipper(Enabled)
  46. If Enabled Then
  47. PlaySound SoundFX("fx_Flipperup",DOFContactors):RightFlipper.RotateToEnd
  48. Else
  49. PlaySound SoundFX("fx_Flipperdown",DOFContactors):RightFlipper.RotateToStart
  50. End If
  51. End Sub
  52. '**********************************************************************************************************
  53.  
  54. 'Solenoid Controlled toys
  55. '**********************************************************************************************************
  56.  
  57.  
  58. Sub solTrough(Enabled) 'controlled by light ID 13
  59. If Enabled Then
  60. bsTrough.ExitSol_On
  61. End If
  62. End Sub
  63.  
  64. Sub solSaucer3(Enabled) 'controlled by light ID 12
  65. If Enabled Then
  66. bsSaucer3.ExitSol_On
  67. End If
  68. End Sub
  69.  
  70. 'Playfield GI controlled by light ID 14
  71. Sub PFGI(Enabled)
  72. If Enabled Then
  73. dim xx, xxx
  74. For each xx in GI:xx.State = 0: Next
  75. For each xxx in AL:xxx.State = 0: Next
  76. timer1.enabled=0
  77. PlaySound "fx_relay"
  78. Else
  79. For each xx in GI:xx.State = 1: Next
  80. PlaySound "fx_relay"
  81. timer1.enabled=1
  82. End If
  83. End Sub
  84.  
  85. '**********************************************************************************************************
  86.  
  87. 'Initiate Table
  88. '**********************************************************************************************************
  89. Dim bsTrough, bsSaucer, bsSaucer2, bsSaucer3, dtL, dtR
  90.  
  91. Sub Table1_Init
  92. vpmInit Me
  93. On Error Resume Next
  94. With Controller
  95. .GameName = cGameName
  96. If Err Then MsgBox "Can't start Game" & cGameName & vbNewLine & Err.Description : Exit Sub
  97. .SplashInfoLine = "Tag-Team Pinball, 1978"&chr(13)&"by MaX"
  98. .HandleMechanics=0
  99. .HandleKeyboard=0
  100. .ShowDMDOnly=1
  101. .ShowFrame=0
  102. .ShowTitle=0
  103. .hidden = 1
  104. On Error Resume Next
  105. .Run GetPlayerHWnd
  106. If Err Then MsgBox Err.Description
  107. On Error Goto 0
  108. End With
  109. On Error Goto 0
  110.  
  111. PinMAMETimer.Interval=PinMAMEInterval
  112. PinMAMETimer.Enabled=1
  113. vpmNudge.TiltSwitch=57
  114. vpmNudge.Sensitivity=2
  115. vpmNudge.TiltObj=Array(Bumper1,Bumper2,Bumper3,LeftSlingshot,RightSlingshot)
  116.  
  117. Set bsTrough=New cvpmBallstack
  118. bsTrough.InitSw 66,0,0,74,0,0,0,0
  119. bsTrough.InitExitSnd SoundFX("ballrelease",DOFContactors), SoundFX("Solenoid",DOFContactors)
  120. bsTrough.InitKick BallRelease,90,6
  121. bsTrough.Balls=2
  122.  
  123. Set bsSaucer=New cvpmBallstack
  124. bsSaucer.InitSaucer sw45,45,200,10
  125. bsSaucer.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)
  126.  
  127. Set bsSaucer2=New cvpmBallstack
  128. bsSaucer2.InitSaucer sw55,55,220,5
  129. bsSaucer2.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)
  130.  
  131. Set bsSaucer3=New cvpmBallstack
  132. bsSaucer3.InitSaucer sw65,65,355,16
  133. bsSaucer3.InitExitSnd SoundFX("Popper",DOFContactors), SoundFX("Solenoid",DOFContactors)
  134.  
  135. Set dtL=New cvpmDropTarget
  136. dtL.InitDrop Array(sw51,sw61,sw71),Array(51,61,71)
  137. dtL.initsnd SoundFX("DTDrop",DOFContactors),SoundFX("DTReset",DOFContactors)
  138.  
  139. Set dtR=New cvpmDropTarget
  140. dtR.InitDrop Array(sw40,sw50,sw60,sw70),Array(40,50,60,70)
  141. dtR.initsnd SoundFX("DTDrop",DOFContactors),SoundFX("DTReset",DOFContactors)
  142.  
  143. bsTrough.addball 0
  144.  
  145. End Sub
  146.  
  147. '**********************************************************************************************************
  148. 'Plunger code
  149. '**********************************************************************************************************
  150.  
  151. Sub Table1_KeyDown(ByVal KeyCode)
  152. If KeyCode=LeftFlipperKey Then Controller.Switch(6)=1
  153. If KeyCode=RightFlipperKey Then
  154. Controller.Switch(64)=1
  155. Controller.Switch(16)=1
  156. End If
  157. If keycode = PlungerKey Then Plunger.Pullback:playsound"plungerpull"
  158. If KeyDownHandler(keycode) Then Exit Sub
  159. End Sub
  160.  
  161. Sub Table1_KeyUp(ByVal KeyCode)
  162. If KeyCode=LeftFlipperKey Then Controller.Switch(6)=0
  163. If KeyCode=RightFlipperKey Then
  164. Controller.Switch(64)=0
  165. Controller.Switch(16)=0
  166. End If
  167. If keycode = PlungerKey Then Plunger.Fire:PlaySound"plunger"
  168. If KeyUpHandler(keycode) Then Exit Sub
  169. End Sub
  170.  
  171. '**********************************************************************************************************
  172.  
  173. ' Drain hole and kickers
  174. Sub Drain_Hit:bsTrough.addball me : playsound"drain" : End Sub
  175. Sub sw45_Hit:bsSaucer.AddBall 0 : playsound "popper_ball": End Sub
  176. Sub sw55_Hit:bsSaucer2.AddBall 0 : playsound "popper_ball": End Sub
  177. Sub sw65_Hit:bsSaucer3.AddBall 0 : playsound "popper_ball": End Sub
  178.  
  179. 'Drop Targets
  180. Sub sw40_Dropped:dtR.Hit 1:End Sub
  181. Sub sw50_Dropped:dtR.Hit 2:End Sub
  182. Sub sw60_Dropped:dtR.Hit 3:End Sub
  183. Sub sw70_Dropped:dtR.Hit 4:End Sub
  184.  
  185. Sub sw51_Dropped:dtL.Hit 1:End Sub
  186. Sub sw61_Dropped:dtL.Hit 2:End Sub
  187. Sub sw71_Dropped:dtL.Hit 3:End Sub
  188.  
  189. 'Wire Triggers
  190. Sub Trigger6_Hit:Controller.Switch(43)=1 : playsound"rollover" : End Sub
  191. Sub Trigger6_unHit:Controller.Switch(43)=0:End Sub
  192. Sub Trigger2_Hit:Controller.Switch(52)=1 : playsound"rollover" : End Sub
  193. Sub Trigger2_unHit:Controller.Switch(52)=0:End Sub
  194. Sub Trigger1_Hit:Controller.Switch(53)=1 : playsound"rollover" : End Sub
  195. Sub Trigger1_unHit:Controller.Switch(53)=0:End Sub
  196. Sub RightInlane_Hit:Controller.Switch(54)=1 : playsound"rollover" : End Sub
  197. Sub RightInlane_unHit:Controller.Switch(54)=0:End Sub
  198. Sub Trigger3_Hit:Controller.Switch(62)=1 : playsound"rollover" : End Sub
  199. Sub Trigger3_unHit:Controller.Switch(62)=0:End Sub
  200. Sub LeftOutlane_Hit:Controller.Switch(63)=1 : playsound"rollover" : End Sub
  201. Sub LeftOutlane_unHit:Controller.Switch(63)=0:End Sub
  202. Sub Trigger4_Hit:Controller.Switch(72)=1 : playsound"rollover" : End Sub
  203. Sub Trigger4_unHit:Controller.Switch(72)=0:End Sub
  204. Sub LeftInlane_Hit:Controller.Switch(73)=1 : playsound"rollover" : End Sub
  205. Sub LeftInlane_unHit:Controller.Switch(73)=0:End Sub
  206.  
  207. 'Gate Trigger
  208. Sub sw41_Hit:vpmTimer.PulseSw 41:End Sub
  209.  
  210. 'Stand Up Targets
  211. Sub sw42_Hit:vpmTimer.PulseSw 42:End Sub
  212.  
  213. 'Scoring Rubber
  214. Sub sw46a_Slingshot:vpmTimer.PulseSw 46 : playsound"flip_hit_3" : End Sub
  215. Sub sw46b_Slingshot:vpmTimer.PulseSw 46 : playsound"flip_hit_3" : End Sub
  216.  
  217. 'Spinners
  218. Sub sw44_Spin:vpmTimer.PulseSw 44 : playsound"fx_spinner" : End Sub
  219.  
  220. 'Bumpers
  221. Sub Bumper1_Hit:vpmTimer.PulseSw 75 : playsound SoundFX("fx_bumper1",DOFContactors): End Sub
  222. Sub Bumper2_Hit:vpmTimer.PulseSw 75 : playsound SoundFX("fx_bumper1",DOFContactors): End Sub
  223. Sub Bumper3_Hit:vpmTimer.PulseSw 75 : playsound SoundFX("fx_bumper1",DOFContactors): End Sub
  224.  
  225.  
  226. Dim AuxCount
  227. AuxCount=-1
  228.  
  229. Sub Timer1_Timer
  230. AuxCount=AuxCount+1
  231. If AuxCount>9 Then AuxCount=0
  232. Select Case AuxCount
  233. Case 0:AL10A.State=0:AL1A.State=1:AL10.State=0:AL1.State=1
  234. Case 1:AL1A.State=0:AL2A.State=1:AL1.State=0:AL2.State=1
  235. Case 2:AL2A.State=0:AL3A.State=1:AL2.State=0:AL3.State=1
  236. Case 3:AL3A.State=0:AL4A.State=1:AL3.State=0:AL4.State=1
  237. Case 4:AL4A.State=0:AL5A.State=1:AL4.State=0:AL5.State=1
  238. Case 5:AL5A.State=0:AL6A.State=1:AL5.State=0:AL6.State=1
  239. Case 6:AL6A.State=0:AL7A.State=1:AL6.State=0:AL7.State=1
  240. Case 7:AL7A.State=0:AL8A.State=1:AL7.State=0:AL8.State=1
  241. Case 8:AL8A.State=0:AL9A.State=1:AL8.State=0:AL9.State=1
  242. Case 9:AL9A.State=0:AL10A.State=1:AL9.State=0:AL10.State=1
  243. End Select
  244. End Sub
  245.  
  246. '***************************************************
  247. ' JP's VP10 Fading Lamps & Flashers
  248. ' Based on PD's Fading Light System
  249. ' SetLamp 0 is Off
  250. ' SetLamp 1 is On
  251. ' fading for non opacity objects is 4 steps
  252. '***************************************************
  253.  
  254. Dim LampState(200), FadingLevel(200)
  255. Dim FlashSpeedUp(200), FlashSpeedDown(200), FlashMin(200), FlashMax(200), FlashLevel(200)
  256.  
  257. InitLamps() ' turn off the lights and flashers and reset them to the default parameters
  258. LampTimer.Interval = 5 'lamp fading speed
  259. LampTimer.Enabled = 1
  260.  
  261. ' Lamp & Flasher Timers
  262.  
  263. Sub LampTimer_Timer()
  264. Dim chgLamp, num, chg, ii
  265. chgLamp = Controller.ChangedLamps
  266. If Not IsEmpty(chgLamp) Then
  267. For ii = 0 To UBound(chgLamp)
  268. LampState(chgLamp(ii, 0) ) = chgLamp(ii, 1) 'keep the real state in an array
  269. FadingLevel(chgLamp(ii, 0) ) = chgLamp(ii, 1) + 4 'actual fading step
  270.  
  271. 'Special Handling
  272. If chgLamp(ii,0) = 12 Then solSaucer3 chgLamp(ii,1)
  273. If chgLamp(ii,0) = 13 Then solTrough chgLamp(ii,1)
  274. If chgLamp(ii,0) = 14 Then PFGI chgLamp(ii,1)
  275.  
  276. Next
  277. End If
  278. UpdateLamps
  279. End Sub
  280.  
  281.  
  282. Sub UpdateLamps()
  283. NFadeL 3, P3 'SHOOT AGAIN
  284. NFadeL 5, P5
  285. NFadeL 6, P6
  286. NFadeL 7, P7
  287. NFadeL 8, P8
  288. NFadeL 9, P9
  289. NFadeL 10, P10
  290. NFadeL 11, P11
  291. 'NFadeL 12, P12'Kicker3
  292. 'NFadeL 13, P13'BallRelease
  293. 'NFadeL 14, P14'GI
  294. NFadeL 15, P15
  295. NFadeLm 16, P16
  296. NFadeL 16, P16B
  297. NFadeL 17, P17
  298. NFadeL 18, P18
  299. NFadeL 19, P19
  300. NFadeL 20, P20
  301. NFadeL 21, P21
  302. NFadeL 22, P22
  303. NFadeL 23, P23
  304. NFadeL 24, P24
  305. NFadeL 25, P25
  306. NFadeL 26, P26
  307. NFadeL 27, P27
  308. NFadeL 28, P28
  309. NFadeL 29, P29
  310. NFadeL 30, P30
  311. NFadeL 31, P31
  312. NFadeL 32, P32
  313. NFadeL 33, P33
  314. NFadeL 34, P34
  315. NFadeL 35, P35
  316. NFadeL 36, P36
  317. NFadeL 37, P37
  318. NFadeL 38, P38
  319. NFadeL 39, P39
  320. NFadeL 40, P40
  321. NFadeL 41, P41
  322. NFadeL 42, P42
  323. NFadeL 43, P43
  324. NFadeL 44, P44
  325. NFadeL 45, P45
  326. NFadeL 46, P46
  327. NFadeLm 47, Light47A
  328. NFadeL 47, Light47B
  329. NFadeL 50, P50
  330. NFadeLm 51, Light51A
  331. NFadeL 51, Light51B
  332.  
  333. end sub
  334.  
  335.  
  336. ' div lamp subs
  337.  
  338. Sub InitLamps()
  339. Dim x
  340. For x = 0 to 200
  341. LampState(x) = 0 ' current light state, independent of the fading level. 0 is off and 1 is on
  342. FadingLevel(x) = 4 ' used to track the fading state
  343. FlashSpeedUp(x) = 0.4 ' faster speed when turning on the flasher
  344. FlashSpeedDown(x) = 0.2 ' slower speed when turning off the flasher
  345. FlashMax(x) = 1 ' the maximum value when on, usually 1
  346. FlashMin(x) = 0 ' the minimum value when off, usually 0
  347. FlashLevel(x) = 0 ' the intensity of the flashers, usually from 0 to 1
  348. Next
  349. End Sub
  350.  
  351. Sub AllLampsOff
  352. Dim x
  353. For x = 0 to 200
  354. SetLamp x, 0
  355. Next
  356. End Sub
  357.  
  358. Sub SetLamp(nr, value)
  359. If value <> LampState(nr) Then
  360. LampState(nr) = abs(value)
  361. FadingLevel(nr) = abs(value) + 4
  362. End If
  363. End Sub
  364.  
  365. ' Lights: used for VP10 standard lights, the fading is handled by VP itself
  366.  
  367. Sub NFadeL(nr, object)
  368. Select Case FadingLevel(nr)
  369. Case 4:object.state = 0:FadingLevel(nr) = 0
  370. Case 5:object.state = 1:FadingLevel(nr) = 1
  371. End Select
  372. End Sub
  373.  
  374. Sub NFadeLm(nr, object) ' used for multiple lights
  375. Select Case FadingLevel(nr)
  376. Case 4:object.state = 0
  377. Case 5:object.state = 1
  378. End Select
  379. End Sub
  380.  
  381. 'Lights, Ramps & Primitives used as 4 step fading lights
  382. 'a,b,c,d are the images used from on to off
  383.  
  384. Sub FadeObj(nr, object, a, b, c, d)
  385. Select Case FadingLevel(nr)
  386. Case 4:object.image = b:FadingLevel(nr) = 6 'fading to off...
  387. Case 5:object.image = a:FadingLevel(nr) = 1 'ON
  388. Case 6, 7, 8:FadingLevel(nr) = FadingLevel(nr) + 1 'wait
  389. Case 9:object.image = c:FadingLevel(nr) = FadingLevel(nr) + 1 'fading...
  390. Case 10, 11, 12:FadingLevel(nr) = FadingLevel(nr) + 1 'wait
  391. Case 13:object.image = d:FadingLevel(nr) = 0 'Off
  392. End Select
  393. End Sub
  394.  
  395. Sub FadeObjm(nr, object, a, b, c, d)
  396. Select Case FadingLevel(nr)
  397. Case 4:object.image = b
  398. Case 5:object.image = a
  399. Case 9:object.image = c
  400. Case 13:object.image = d
  401. End Select
  402. End Sub
  403.  
  404. Sub NFadeObj(nr, object, a, b)
  405. Select Case FadingLevel(nr)
  406. Case 4:object.image = b:FadingLevel(nr) = 0 'off
  407. Case 5:object.image = a:FadingLevel(nr) = 1 'on
  408. End Select
  409. End Sub
  410.  
  411. Sub NFadeObjm(nr, object, a, b)
  412. Select Case FadingLevel(nr)
  413. Case 4:object.image = b
  414. Case 5:object.image = a
  415. End Select
  416. End Sub
  417.  
  418. ' Flasher objects
  419.  
  420. Sub Flash(nr, object)
  421. Select Case FadingLevel(nr)
  422. Case 4 'off
  423. FlashLevel(nr) = FlashLevel(nr) - FlashSpeedDown(nr)
  424. If FlashLevel(nr) < FlashMin(nr) Then
  425. FlashLevel(nr) = FlashMin(nr)
  426. FadingLevel(nr) = 0 'completely off
  427. End if
  428. Object.IntensityScale = FlashLevel(nr)
  429. Case 5 ' on
  430. FlashLevel(nr) = FlashLevel(nr) + FlashSpeedUp(nr)
  431. If FlashLevel(nr) > FlashMax(nr) Then
  432. FlashLevel(nr) = FlashMax(nr)
  433. FadingLevel(nr) = 1 'completely on
  434. End if
  435. Object.IntensityScale = FlashLevel(nr)
  436. End Select
  437. End Sub
  438.  
  439. Sub Flashm(nr, object) 'multiple flashers, it just sets the flashlevel
  440. Object.IntensityScale = FlashLevel(nr)
  441. End Sub
  442.  
  443. '**********************************************************************************************************
  444. 'Digital Display
  445. '**********************************************************************************************************
  446. Dim Digits(40)
  447. Digits(0)=Array(a00, a05, a0c, a0d, a08, a01, a06, a0f, a02, a03, a04, a07, a0b, a0a, a09, a0e)
  448. Digits(1)=Array(a10, a15, a1c, a1d, a18, a11, a16, a1f, a12, a13, a14, a17, a1b, a1a, a19, a1e)
  449. Digits(2)=Array(a20, a25, a2c, a2d, a28, a21, a26, a2f, a22, a23, a24, a27, a2b, a2a, a29, a2e)
  450. Digits(3)=Array(a30, a35, a3c, a3d, a38, a31, a36, a3f, a32, a33, a34, a37, a3b, a3a, a39, a3e)
  451. Digits(4)=Array(a40, a45, a4c, a4d, a48, a41, a46, a4f, a42, a43, a44, a47, a4b, a4a, a49, a4e)
  452. Digits(5)=Array(a50, a55, a5c, a5d, a58, a51, a56, a5f, a52, a53, a54, a57, a5b, a5a, a59, a5e)
  453. Digits(6)=Array(a60, a65, a6c, a6d, a68, a61, a66, a6f, a62, a63, a64, a67, a6b, a6a, a69, a6e)
  454. Digits(7)=Array(a70, a75, a7c, a7d, a78, a71, a76, a7f, a72, a73, a74, a77, a7b, a7a, a79, a7e)
  455. Digits(8)=Array(a80, a85, a8c, a8d, a88, a81, a86, a8f, a82, a83, a84, a87, a8b, a8a, a89, a8e)
  456. Digits(9)=Array(a90, a95, a9c, a9d, a98, a91, a96, a9f, a92, a93, a94, a97, a9b, a9a, a99, a9e)
  457. Digits(10)=Array(aa0, aa5, aac, aad, aa8, aa1, aa6, aaf, aa2, aa3, aa4, aa7, aab, aaa, aa9, aae)
  458. Digits(11)=Array(ab0, ab5, abc, abd, ab8, ab1, ab6, abf, ab2, ab3, ab4, ab7, abb, aba, ab9, abe)
  459. Digits(12)=Array(ac0, ac5, acc, acd, ac8, ac1, ac6, acf, ac2, ac3, ac4, ac7, acb, aca, ac9, ace)
  460. Digits(13)=Array(ad0, ad5, adc, add, ad8, ad1, ad6, adf, ad2, ad3, ad4, ad7, adb, ada, ad9, ade)
  461. Digits(14)=Array(ae0, ae5, aec, aed, ae8, ae1, ae6, aef, ae2, ae3, ae4, ae7, aeb, aea, ae9, aee)
  462. Digits(15)=Array(af0, af5, afc, afd, af8, af1, af6, aff, af2, af3, af4, af7, afb, afa, af9, afe)
  463. Digits(16)=Array(b00, b05, b0c, b0d, b08, b01, b06, b0f, b02, b03, b04, b07, b0b, b0a, b09, b0e)
  464. Digits(17)=Array(b10, b15, b1c, b1d, b18, b11, b16, b1f, b12, b13, b14, b17, b1b, b1a, b19, b1e)
  465. Digits(18)=Array(b20, b25, b2c, b2d, b28, b21, b26, b2f, b22, b23, b24, b27, b2b, b2a, b29, b2e)
  466. Digits(19)=Array(b30, b35, b3c, b3d, b38, b31, b36, b3f, b32, b33, b34, b37, b3b, b3a, b39, b3e)
  467.  
  468. Digits(20)=Array(b40, b45, b4c, b4d, b48, b41, b46, b4f, b42, b43, b44, b47, b4b, b4a, b49, b4e)
  469. Digits(21)=Array(b50, b55, b5c, b5d, b58, b51, b56, b5f, b52, b53, b54, b57, b5b, b5a, b59, b5e)
  470. Digits(22)=Array(b60, b65, b6c, b6d, b68, b61, b66, b6f, b62, b63, b64, b67, b6b, b6a, b69, b6e)
  471. Digits(23)=Array(b70, b75, b7c, b7d, b78, b71, b76, b7f, b72, b73, b74, b77, b7b, b7a, b79, b7e)
  472. Digits(24)=Array(b80, b85, b8c, b8d, b88, b81, b86, b8f, b82, b83, b84, b87, b8b, b8a, b89, b8e)
  473. Digits(25)=Array(b90, b95, b9c, b9d, b98, b91, b96, b9f, b92, b93, b94, b97, b9b, b9a, b99, b9e)
  474. Digits(26)=Array(ba0, ba5, bac, bad, ba8, ba1, ba6, baf, ba2, ba3, ba4, ba7, bab, baa, ba9, bae)
  475. Digits(27)=Array(bb0, bb5, bbc, bbd, bb8, bb1, bb6, bbf, bb2, bb3, bb4, bb7, bbb, bba, bb9, bbe)
  476. Digits(28)=Array(bc0, bc5, bcc, bcd, bc8, bc1, bc6, bcf, bc2, bc3, bc4, bc7, bcb, bca, bc9, bce)
  477. Digits(29)=Array(bd0, bd5, bdc, bdd, bd8, bd1, bd6, bdf, bd2, bd3, bd4, bd7, bdb, bda, bd9, bde)
  478. Digits(30)=Array(be0, be5, bec, bed, be8, be1, be6, bef, be2, be3, be4, be7, beb, bea, be9, bee)
  479. Digits(31)=Array(bf0, bf5, bfc, bfd, bf8, bf1, bf6, bff, bf2, bf3, bf4, bf7, bfb, bfa, bf9, bfe)
  480. Digits(32)=Array(ac18, ac16, acc1, acd1, ac19, ac17, ac15, acf1, ac11, ac13, ac12, ac14, acb1, aca1, ac10, ace1)
  481. Digits(33)=Array(ad18, ad16, adc1, add1, ad19, ad17, ad15, adf1, ad11, ad13, ad12, ad14, adb1, ada1, ad10, ade1)
  482. Digits(34)=Array(ae18, ae16, aec1, aed1, ae19, ae17, ae15, aef1, ae11, ae13, ae12, ae14, aeb1, aea1, ae10, aee1)
  483. Digits(35)=Array(af18, af16, afc1, afd1, af19, af17, af15, aff1, af11, af13, af12, af14, afb1, afa1, af10, afe1)
  484. Digits(36)=Array(b9, b7, b0c1, b0d1, b100, b8, b6, b0f1, b2, b4, b3, b5, b0b1, b0a1, b1,b0e1)
  485. Digits(37)=Array(b109, b107, b1c1, b1d1, b110, b108, b106, b1f1, b102, b104, b103, b105, b1b1, b1a1, b101,b1e1)
  486. Digits(38)=Array(b119, b117, b2c1, b2d1, b120, b118, b116, b2f1, b112, b114, b113, b115, b2b1, b2a1, b111, b2e1)
  487. Digits(39)=Array(b129, b127, b3c1, b3d1, b130, b128, b126, b3f1, b122, b3b1, b123, b125, b3b1, b3a1, b121, b3e1)
  488.  
  489.  
  490. Sub DisplayTimer_Timer
  491. Dim ChgLED, ii, jj, num, chg, stat, obj, b, x
  492. ChgLED=Controller.ChangedLEDs(&Hffffffff, &Hffffffff)
  493. If Not IsEmpty(ChgLED)Then
  494. If DesktopMode = True Then
  495. For ii=0 To UBound(chgLED)
  496. num=chgLED(ii, 0) : chg=chgLED(ii, 1) : stat=chgLED(ii, 2)
  497. if (num < 40) then
  498. For Each obj In Digits(num)
  499. If chg And 1 Then obj.State=stat And 1
  500. chg=chg\2 : stat=stat\2
  501. Next
  502. Else
  503. end if
  504. Next
  505. end if
  506. End If
  507. End Sub
  508.  
  509. '**********************************************************************************************************
  510. '**********************************************************************************************************
  511.  
  512. 'Gottlieb System 80B
  513. 'added by Inkochnito
  514. Sub editDips
  515. Dim vpmDips : Set vpmDips = New cvpmDips
  516. With vpmDips
  517. .AddForm 700,400,"System 80B - DIP switches"
  518. .AddFrame 2,4,190,"Maximum credits",49152,Array("8 credits",0,"10 credits",32768,"15 credits",&H00004000,"20 credits",49152)'dip 15&16
  519. .AddFrame 2,80,190,"Coin chute 1 and 2 control",&H00002000,Array("seperate",0,"same",&H00002000)'dip 14
  520. .AddFrame 2,126,190,"Playfield special",&H00200000,Array("replay",0,"extra ball",&H00200000)'dip 22
  521. .AddFrame 2,172,190,"High games to date control",&H00000020,Array("no effect",0,"reset high games 2-5 on power off",&H00000020)'dip 6
  522. .AddFrame 2,218,190,"3rd coin chute credits control",&H20000000,Array("no effect",0,"add 9",&H20000000)'dip 30
  523. .AddFrame 2,264,190,"Game option dip 7",&H00000040,Array("off",0,"on",&H00000040)'dip 7
  524. .AddFrame 2,310,190,"Game option dip 8",&H00000080,Array("off",0,"on",&H00000080)'dip 8
  525. .AddFrame 205,4,190,"High game to date awards",&H00C00000,Array("not displayed and no award",0,"displayed and no award",&H00800000,"displayed and 2 replays",&H00400000,"displayed and 3 replays",&H00C00000)'dip 23&24
  526. .AddFrame 205,80,190,"Balls per game",&H01000000,Array("5 balls",0,"3 balls",&H01000000)'dip 25
  527. .AddFrame 205,126,190,"Replay limit",&H04000000,Array("no limit",0,"one per game",&H04000000)'dip 27
  528. .AddFrame 205,172,190,"Novelty",&H08000000,Array("normal",0,"extra ball and replay scores 500K",&H08000000)'dip 28
  529. .AddFrame 205,218,190,"Game mode",&H10000000,Array("replay",0,"extra ball",&H10000000)'dip 29
  530. .AddFrame 205,264,190,"Game option dip 31",&H40000000,Array("off",0,"on",&H40000000)'dip 31
  531. .AddFrame 205,310,190,"Game option dip 32",&H80000000,Array("off",0,"on",&H80000000)'dip 32
  532. .AddChk 2,360,120,Array("Match feature",&H02000000)'dip 26
  533. .AddLabel 50,380,300,20,"After hitting OK, press F3 to reset game with new settings."
  534. .ViewDips
  535. End With
  536. End Sub
  537. Set vpmShowDips = GetRef("editDips")
  538.  
  539. '**********************************************************************************************************
  540. '**********************************************************************************************************
  541.  
  542.  
  543. '**********Sling Shot Animations
  544. ' Rstep and Lstep are the variables that increment the animation
  545. '****************
  546. Dim RStep, Lstep
  547.  
  548. Sub RightSlingShot_Slingshot
  549. vpmTimer.PulseSw 46
  550. PlaySound SoundFX("right_slingshot",DOFContactors), 0,1, 0.05,0.05 '0,1, AudioPan(RightSlingShot), 0.05,0,0,1,AudioFade(RightSlingShot)
  551. RSling.Visible = 0
  552. RSling1.Visible = 1
  553. sling1.rotx = 20
  554. RStep = 0
  555. RightSlingShot.TimerEnabled = 1
  556. End Sub
  557.  
  558. Sub RightSlingShot_Timer
  559. Select Case RStep
  560. Case 3:RSLing1.Visible = 0:RSLing2.Visible = 1:sling1.rotx = 10
  561. Case 4:RSLing2.Visible = 0:RSLing.Visible = 1:sling1.rotx = 0:RightSlingShot.TimerEnabled = 0
  562. End Select
  563. RStep = RStep + 1
  564. End Sub
  565.  
  566. Sub LeftSlingShot_Slingshot
  567. vpmTimer.PulseSw 46
  568. PlaySound SoundFX("left_slingshot",DOFContactors), 0,1, -0.05,0.05 '0,1, AudioPan(LeftSlingShot), 0.05,0,0,1,AudioFade(LeftSlingShot)
  569. LSling.Visible = 0
  570. LSling1.Visible = 1
  571. sling2.rotx = 20
  572. LStep = 0
  573. LeftSlingShot.TimerEnabled = 1
  574. End Sub
  575.  
  576. Sub LeftSlingShot_Timer
  577. Select Case LStep
  578. Case 3:LSLing1.Visible = 0:LSLing2.Visible = 1:sling2.rotx = 10
  579. Case 4:LSLing2.Visible = 0:LSLing.Visible = 1:sling2.rotx = 0:LeftSlingShot.TimerEnabled = 0
  580. End Select
  581. LStep = LStep + 1
  582. End Sub
  583.  
  584.  
  585. '*********************************************************************
  586. ' Positional Sound Playback Functions
  587. '*********************************************************************
  588.  
  589. ' Play a sound, depending on the X,Y position of the table element (especially cool for surround speaker setups, otherwise stereo panning only)
  590. ' parameters (defaults): loopcount (1), volume (1), randompitch (0), pitch (0), useexisting (0), restart (1))
  591. ' Note that this will not work (currently) for walls/slingshots as these do not feature a simple, single X,Y position
  592. Sub PlayXYSound(soundname, tableobj, loopcount, volume, randompitch, pitch, useexisting, restart)
  593. PlaySound soundname, loopcount, volume, AudioPan(tableobj), randompitch, pitch, useexisting, restart, AudioFade(tableobj)
  594. End Sub
  595.  
  596. ' Similar subroutines that are less complicated to use (e.g. simply use standard parameters for the PlaySound call)
  597. Sub PlaySoundAt(soundname, tableobj)
  598. PlaySound soundname, 1, 1, AudioPan(tableobj), 0,0,0, 1, AudioFade(tableobj)
  599. End Sub
  600.  
  601. Sub PlaySoundAtBall(soundname)
  602. PlaySoundAt soundname, ActiveBall
  603. End Sub
  604.  
  605.  
  606. '*********************************************************************
  607. ' Supporting Ball & Sound Functions
  608. '*********************************************************************
  609.  
  610. 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
  611. Dim tmp
  612. tmp = tableobj.y * 2 / table1.height-1
  613. If tmp > 0 Then
  614. AudioFade = Csng(tmp ^10)
  615. Else
  616. AudioFade = Csng(-((- tmp) ^10) )
  617. End If
  618. End Function
  619.  
  620. Function AudioPan(tableobj) ' Calculates the pan for a tableobj based on the X position on the table. "table1" is the name of the table
  621. Dim tmp
  622. tmp = tableobj.x * 2 / table1.width-1
  623. If tmp > 0 Then
  624. AudioPan = Csng(tmp ^10)
  625. Else
  626. AudioPan = Csng(-((- tmp) ^10) )
  627. End If
  628. End Function
  629.  
  630. Function Vol(ball) ' Calculates the Volume of the sound based on the ball speed
  631. Vol = Csng(BallVel(ball) ^2 / 2000)
  632. End Function
  633.  
  634. Function Pitch(ball) ' Calculates the pitch of the sound based on the ball speed
  635. Pitch = BallVel(ball) * 20
  636. End Function
  637.  
  638. Function BallVel(ball) 'Calculates the ball speed
  639. BallVel = INT(SQR((ball.VelX ^2) + (ball.VelY ^2) ) )
  640. End Function
  641.  
  642.  
  643.  
  644. '*****************************************
  645. ' JP's VP10 Rolling Sounds
  646. '*****************************************
  647.  
  648. Const tnob = 5 ' total number of balls
  649. ReDim rolling(tnob)
  650. InitRolling
  651.  
  652. Sub InitRolling
  653. Dim i
  654. For i = 0 to tnob
  655. rolling(i) = False
  656. Next
  657. End Sub
  658.  
  659. Sub RollingTimer_Timer()
  660. Dim BOT, b
  661. BOT = GetBalls
  662.  
  663. ' stop the sound of deleted balls
  664. For b = UBound(BOT) + 1 to tnob
  665. rolling(b) = False
  666. StopSound("fx_ballrolling" & b)
  667. Next
  668.  
  669. ' exit the sub if no balls on the table
  670. If UBound(BOT) = -1 Then Exit Sub
  671.  
  672. ' play the rolling sound for each ball
  673. For b = 0 to UBound(BOT)
  674. If BallVel(BOT(b) ) > 1 AND BOT(b).z < 30 Then
  675. rolling(b) = True
  676. PlaySound("fx_ballrolling" & b), -1, Vol(BOT(b)), AudioPan(BOT(b)), 0, Pitch(BOT(b)), 1, 0, AudioFade(BOT(b))
  677. Else
  678. If rolling(b) = True Then
  679. StopSound("fx_ballrolling" & b)
  680. rolling(b) = False
  681. End If
  682. End If
  683. Next
  684. End Sub
  685.  
  686. '**********************
  687. ' Ball Collision Sound
  688. '**********************
  689.  
  690. Sub OnBallBallCollision(ball1, ball2, velocity)
  691. PlaySound("fx_collide"), 0, Csng(velocity) ^2 / 2000, AudioPan(ball1), 0, Pitch(ball1), 0, 0, AudioFade(ball1)
  692. End Sub
  693.  
  694.  
  695. '*****************************************
  696. ' ninuzzu's FLIPPER SHADOWS
  697. '*****************************************
  698.  
  699. sub FlipperTimer_Timer()
  700. FlipperLSh.RotZ = LeftFlipper.currentangle
  701. FlipperRSh.RotZ = RightFlipper.currentangle
  702. FlipperLSh1.RotZ = Flipper1.currentangle
  703.  
  704. LFLogo.RotY = LeftFlipper.CurrentAngle
  705. LFLogo2.RotY = Flipper1.CurrentAngle
  706. RFLogo.RotY = RightFlipper.CurrentAngle
  707.  
  708. End Sub
  709.  
  710. '*****************************************
  711. ' ninuzzu's BALL SHADOW
  712. '*****************************************
  713. Dim BallShadow
  714. BallShadow = Array (BallShadow1,BallShadow2,BallShadow3,BallShadow4,BallShadow5)
  715.  
  716. Sub BallShadowUpdate_timer()
  717. Dim BOT, b
  718. BOT = GetBalls
  719. ' hide shadow of deleted balls
  720. If UBound(BOT)<(tnob-1) Then
  721. For b = (UBound(BOT) + 1) to (tnob-1)
  722. BallShadow(b).visible = 0
  723. Next
  724. End If
  725. ' exit the Sub if no balls on the table
  726. If UBound(BOT) = -1 Then Exit Sub
  727. ' render the shadow for each ball
  728. For b = 0 to UBound(BOT)
  729. If BOT(b).X < Table1.Width/2 Then
  730. BallShadow(b).X = ((BOT(b).X) - (Ballsize/6) + ((BOT(b).X - (Table1.Width/2))/7)) + 6
  731. Else
  732. BallShadow(b).X = ((BOT(b).X) + (Ballsize/6) + ((BOT(b).X - (Table1.Width/2))/7)) - 6
  733. End If
  734. ballShadow(b).Y = BOT(b).Y + 12
  735. If BOT(b).Z > 20 Then
  736. BallShadow(b).visible = 1
  737. Else
  738. BallShadow(b).visible = 0
  739. End If
  740. Next
  741. End Sub
  742.  
  743.  
  744.  
  745. '************************************
  746. ' What you need to add to your table
  747. '************************************
  748.  
  749. ' a timer called RollingTimer. With a fast interval, like 10
  750. ' one collision sound, in this script is called fx_collide
  751. ' as many sound files as max number of balls, with names ending with 0, 1, 2, 3, etc
  752. ' for ex. as used in this script: fx_ballrolling0, fx_ballrolling1, fx_ballrolling2, fx_ballrolling3, etc
  753.  
  754.  
  755. '******************************************
  756. ' Explanation of the rolling sound routine
  757. '******************************************
  758.  
  759. ' sounds are played based on the ball speed and position
  760.  
  761. ' the routine checks first for deleted balls and stops the rolling sound.
  762.  
  763. ' The For loop goes through all the balls on the table and checks for the ball speed and
  764. ' if the ball is on the table (height lower than 30) then then it plays the sound
  765. ' otherwise the sound is stopped, like when the ball has stopped or is on a ramp or flying.
  766.  
  767. ' The sound is played using the VOL, AUDIOPAN, AUDIOFADE and PITCH functions, so the volume and pitch of the sound
  768. ' will change according to the ball speed, and the AUDIOPAN & AUDIOFADE functions will change the stereo position
  769. ' according to the position of the ball on the table.
  770.  
  771.  
  772. '**************************************
  773. ' Explanation of the collision routine
  774. '**************************************
  775.  
  776. ' The collision is built in VP.
  777. ' You only need to add a Sub OnBallBallCollision(ball1, ball2, velocity) and when two balls collide they
  778. ' 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
  779. ' depending of the speed of the collision.
  780.  
  781.  
  782. Sub Pins_Hit (idx)
  783. PlaySound "pinhit_low", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall)
  784. End Sub
  785.  
  786. Sub Targets_Hit (idx)
  787. PlaySound "target", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall)
  788. End Sub
  789.  
  790. Sub Metals_Thin_Hit (idx)
  791. PlaySound "metalhit_thin", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  792. End Sub
  793.  
  794. Sub Metals_Medium_Hit (idx)
  795. PlaySound "metalhit_medium", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  796. End Sub
  797.  
  798. Sub Metals2_Hit (idx)
  799. PlaySound "metalhit2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  800. End Sub
  801.  
  802. Sub Gates_Hit (idx)
  803. PlaySound "gate4", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  804. End Sub
  805.  
  806. Sub Spinner_Spin
  807. PlaySound "fx_spinner", 0, .25, AudioPan(Spinner), 0.25, 0, 0, 1, AudioFade(Spinner)
  808. End Sub
  809.  
  810. Sub Rubbers_Hit(idx)
  811. dim finalspeed
  812. finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
  813. If finalspeed > 20 then
  814. PlaySound "fx_rubber2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  815. End if
  816. If finalspeed >= 6 AND finalspeed <= 20 then
  817. RandomSoundRubber()
  818. End If
  819. End Sub
  820.  
  821. Sub Posts_Hit(idx)
  822. dim finalspeed
  823. finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
  824. If finalspeed > 16 then
  825. PlaySound "fx_rubber2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  826. End if
  827. If finalspeed >= 6 AND finalspeed <= 16 then
  828. RandomSoundRubber()
  829. End If
  830. End Sub
  831.  
  832. Sub RandomSoundRubber()
  833. Select Case Int(Rnd*3)+1
  834. Case 1 : PlaySound "rubber_hit_1", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  835. Case 2 : PlaySound "rubber_hit_2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  836. Case 3 : PlaySound "rubber_hit_3", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  837. End Select
  838. End Sub
  839.  
  840. Sub LeftFlipper_Collide(parm)
  841. RandomSoundFlipper()
  842. End Sub
  843.  
  844. Sub RightFlipper_Collide(parm)
  845. RandomSoundFlipper()
  846. End Sub
  847.  
  848. Sub RandomSoundFlipper()
  849. Select Case Int(Rnd*3)+1
  850. Case 1 : PlaySound "flip_hit_1", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  851. Case 2 : PlaySound "flip_hit_2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  852. Case 3 : PlaySound "flip_hit_3", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  853. End Select
  854. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement