API tools faq
paste
Outhere

Cleopatra

Outhere
Aug 12th, 2021 (edited)
141
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 47.31 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="cleoptra",UseSolenoids=1,UseLamps=1,UseGI=0,SSolenoidOn="SolOn",SSolenoidOff="SolOff",SCoin="coin"
  10.  
  11.  
  12. LoadVPM"01500000","GTS1.VBS",3.10
  13. Dim DesktopMode: DesktopMode = Table1.ShowDT
  14.  
  15. 'Flipper Rampup mode: 0 = fast, 1 = medium, 2 = slow (tap passes should work)
  16. dim FlipperCoilRampupMode : FlipperCoilRampupMode = 1
  17.  
  18. 'What's new:
  19. ' Added nFozzy flippers
  20. ' Added Playfield mesh (thanks @Thalamus)
  21. ' Gates and brackets positioned correctly
  22. ' Kickers eject angle corrected
  23. ' Light6 and Light16 are now working
  24. ' Fixed Playfield mistake around star triggers area
  25. ' Fixed Bumpers image (100 Points istad of 1000)
  26. ' New lights, new lighting
  27. ' Added Flippers Shadows and Ball Shadows
  28. ' New table physics
  29. ' Added new Gottlieb flippers primitives
  30. ' Reworked the GI
  31. ' EM rubber rebounder positined correctly
  32. ' Changed Drop Targets type and height so they don't disappear when down
  33. ' Reworked all the images, cleaned and upscaled
  34. ' Added\Adjusted missing and existing mechanical sounds and replaced ball rolling sound
  35. ' Tuned Slingshots force
  36. ' Corrected Rubbers Hit Height
  37. ' Added JP's LUT code
  38. ' New instruction Cards in the apron
  39. ' Repositioned Bumpers correctly
  40. ' Adjusted general table physics
  41.  
  42.  
  43. '*************************************************************
  44.  
  45. 'Solenoid Call backs
  46. '**********************************************************************************************************
  47. SolCallback(1)="bsTrough.SolOut"
  48. SolCallback(2)="vpmSolSound ""Knocker"","
  49. SolCallback(3)="vpmSolSound ""10pts"","
  50. SolCallback(4)="vpmSolSound ""100pts"","
  51. SolCallback(5)="vpmSolSound ""1000pts"","
  52. SolCallback(6)="bsSaucer2.SolOut"
  53. SolCallback(7)="bsSaucer1.SolOut"
  54. SolCallback(8)="dtDrop.SolDropUp"
  55. SolCallback(17)="vpmNudge.SolGameOn"
  56.  
  57. SolCallback(sLRFlipper) = "SolRFlipper"
  58. SolCallback(sLLFlipper) = "SolLFlipper"
  59.  
  60. Sub SolLFlipper(Enabled)
  61. If Enabled Then
  62. PlaySound SoundFx("fx_Flipperup",DOFFlippers):LeftFlipper.RotateToEnd
  63. LF.FIRE
  64. Else
  65. PlaySound SoundFx("fx_Flipperdown",DOFFlippers):LeftFlipper.RotateToStart
  66. End If
  67. End Sub
  68.  
  69. Sub SolRFlipper(Enabled)
  70. If Enabled Then
  71. PlaySound SoundFx("fx_Flipperup",DOFFlippers):RightFlipper.RotateToEnd
  72. RF.FIRE
  73. Else
  74. PlaySound SoundFx("fx_Flipperdown",DOFFlippers):RightFlipper.RotateToStart
  75. End If
  76. End Sub
  77.  
  78. '************************************************************************
  79.  
  80. '*****GI Lights On
  81. dim xx
  82.  
  83. For each xx in GI:xx.State = 1: Next
  84.  
  85. '**********************************************************************************************************
  86.  
  87. 'Initiate Table
  88. '**********************************************************************************************************
  89. Dim bsTrough, dtDrop, bsSaucer1, bsSaucer2
  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 = "Cleopatra (Gottlieb 1977)"&chr(13)&"You Suck"
  98. .HandleMechanics=0
  99. .HandleKeyboard=0
  100. .ShowDMDOnly=1
  101. .ShowFrame=0
  102. .ShowTitle=0
  103. .Hidden = 1
  104. If Err Then MsgBox Err.Description
  105. End With
  106. On Error Goto 0
  107. Controller.SolMask(0)=0
  108. vpmTimer.AddTimer 2000,"Controller.SolMask(0)=&Hffffffff'" 'ignore all solenoids - then add the timer to renable all the solenoids after 2 seconds
  109. Controller.Run
  110. If Err Then MsgBox Err.Description
  111. On Error Goto 0
  112.  
  113. PinMAMETimer.Interval=PinMAMEInterval
  114. PinMAMETimer.Enabled=1
  115.  
  116. vpmNudge.TiltSwitch=4
  117. vpmNudge.Sensitivity=3
  118. vpmNudge.TiltObj=Array(Bumper1,Bumper2,Bumper3,LeftSlingshot,RightSlingshot)
  119.  
  120. Set bsTrough=New cvpmBallStack
  121. bsTrough.InitSw 0,66,0,0,0,0,0,0
  122. bsTrough.InitKick BallRelease,90,10
  123. bsTrough.InitExitSnd SoundFX("Ballrelease",DOFContactors),SoundFX("Solenoid",DOFContactors)
  124. bsTrough.Balls=1
  125.  
  126. Set dtDrop=New cvpmDropTarget
  127. dtDrop.InitDrop Array(sw24,sw23,sw32,sw43,sw30),Array(24,23,32,43,30)
  128. dtDrop.InitSnd SoundFX("DTDrop",DOFContactors),SoundFX("DTReset",DOFContactors)
  129.  
  130.  
  131. Set bsSaucer1=New cvpmBallstack
  132. bsSaucer1.InitSaucer Kicker1,42,50,16
  133. bsSaucer1.InitExitSnd SoundFX("Popper",DOFContactors),SoundFX("Solenoid",DOFContactors)
  134. bsSaucer1.KickAngleVar=15
  135. bsSaucer1.KickForceVar = 5
  136.  
  137. Set bsSaucer2=New cvpmBallstack
  138. bsSaucer2.InitSaucer Kicker2,41,300,16
  139. bsSaucer2.InitExitSnd SoundFX("Popper",DOFContactors),SoundFX("Solenoid",DOFContactors)
  140. bsSaucer2.KickAngleVar=15
  141. bsSaucer2.KickForceVar = 5
  142.  
  143. End Sub
  144.  
  145. '**********************************************************************************************************
  146. 'Plunger code
  147. '**********************************************************************************************************
  148.  
  149. Sub Table1_KeyDown(ByVal keycode)
  150. If vpmKeyDown(KeyCode) Then Exit Sub
  151. If keycode = LeftFlipperKey Then lfpress = 1
  152. If keycode = RightFlipperKey Then rfpress = 1
  153.  
  154. If keycode = LeftMagnaSave Then bLutActive = True
  155. If keycode = RightMagnaSave Then
  156. If bLutActive Then NextLUT: End If
  157. End If
  158. If keycode=PlungerKey Then Plunger.Pullback:playsound"plungerpull"
  159. End Sub
  160.  
  161. Sub Table1_KeyUp(ByVal keycode)
  162. If vpmKeyUp(KeyCode) Then Exit Sub
  163. If keycode = LeftFlipperKey Then
  164. lfpress = 0
  165. leftflipper.eostorqueangle = EOSA
  166. leftflipper.eostorque = EOST
  167. End If
  168. If keycode = RightFlipperKey Then
  169. rfpress = 0
  170. rightflipper.eostorqueangle = EOSA
  171. rightflipper.eostorque = EOST
  172. End If
  173.  
  174. If keycode = LeftMagnaSave Then bLutActive = False
  175. If keycode=PlungerKey Then Plunger.Fire:playsound"plunger"
  176. End Sub
  177. '**********************************************************************************************************
  178.  
  179. 'Drain hole
  180. Sub Drain_Hit:playsound"drain":bsTrough.addball me:End Sub
  181. Sub Kicker1_Hit:bsSaucer1.AddBall 0:End Sub
  182. Sub Kicker2_Hit:bsSaucer2.AddBall 0:End Sub
  183.  
  184. 'Non Primitive sling shots
  185. Sub SW10a_Hit:vpmTimer.PulseSw 10 : playsound"slingshot" : End Sub
  186. Sub SW10b_Hit:vpmTimer.PulseSw 10 : playsound"slingshot" : End Sub
  187. Sub SW10c_Hit:vpmTimer.PulseSw 10 : playsound"slingshot" : End Sub
  188. Sub SW10d_Hit:vpmTimer.PulseSw 10 : playsound"slingshot" : End Sub
  189. Sub SW10e_Hit:vpmTimer.PulseSw 10 : playsound"slingshot" : End Sub
  190. Sub SW10f_Hit:vpmTimer.PulseSw 10 : playsound"slingshot" : End Sub
  191. Sub SW10g_Hit:vpmTimer.PulseSw 10 : playsound"slingshot" : End Sub
  192. Sub SW10h_Hit:vpmTimer.PulseSw 10 : playsound"slingshot" : End Sub
  193.  
  194.  
  195. 'Standup Target
  196. Sub sw12_Hit:vpmTimer.PulseSw 12 :PlaySound SoundFX("Target",DOFTargets),0,1,-0.15,0.1:End Sub
  197. Sub sw13_Hit:vpmTimer.PulseSw 13 :PlaySound SoundFX("Target",DOFTargets),0,1,-0.15,0.1:End Sub
  198. Sub sw14_Hit:vpmTimer.PulseSw 14 :PlaySound SoundFX("Target",DOFTargets),0,1,-0.15,0.1:End Sub
  199.  
  200. 'lower Wire triggers
  201. Sub sw1_Hit:Controller.Switch(33)=1 : playsound"rollover" : End Sub
  202. Sub sw1_Unhit:Controller.Switch(33)=0:End Sub
  203. Sub sw2_Hit:Controller.Switch(34)=1 : playsound"rollover" : End Sub
  204. Sub sw2_Unhit:Controller.Switch(34)=0:End Sub
  205. Sub sw3_Hit:Controller.Switch(20)=1 : playsound"rollover" : End Sub
  206. Sub sw3_Unhit:Controller.Switch(20)=0:End Sub
  207. Sub sw4_Hit:Controller.Switch(21)=1 : playsound"rollover" : End Sub
  208. Sub sw4_UnHit:Controller.Switch(21)=0:End Sub
  209. 'Upper Wire triggers
  210. Sub sw20_Hit:Controller.Switch(20)=1 : playsound"rollover" : End Sub
  211. Sub sw20_UnHit:Controller.Switch(20)=0:End Sub
  212. Sub sw21_Hit:Controller.Switch(21)=1 : playsound"rollover" : End Sub
  213. Sub sw21_UnHit:Controller.Switch(21)=0:End Sub
  214. Sub sw31_Hit:Controller.Switch(31)=1 : playsound"rollover" : End Sub
  215. Sub sw31_UnHit:Controller.Switch(31)=0:End Sub
  216. Sub sw33_Hit:Controller.Switch(33)=1 : playsound"rollover" : End Sub
  217. Sub sw33_UnHit:Controller.Switch(33)=0:End Sub
  218. Sub sw34_Hit:Controller.Switch(34)=1 : playsound"rollover" : End Sub
  219. Sub sw34_UnHit:Controller.Switch(34)=0:End Sub
  220.  
  221. 'Drop Targets
  222. Sub Sw23_Hit: dtDrop.Hit 2: End Sub
  223. Sub Sw24_Hit: dtDrop.Hit 1: End Sub
  224. Sub Sw30_Hit: dtDrop.Hit 5: End Sub
  225. Sub Sw32_Hit: dtDrop.Hit 3: End Sub
  226. Sub Sw43_Hit: dtDrop.Hit 4: End Sub
  227.  
  228.  
  229. 'Star Trigger Animation
  230. Sub sw22_Hit:controller.switch(22)=1 : playsound"rollover" : End Sub
  231. Sub sw22_Unhit:controller.switch(22)=0:End Sub
  232. Sub sw22a_Hit:controller.switch(22)=1 : playsound"rollover" : End Sub
  233. Sub sw22a_UnHit:controller.switch(22)=0:End Sub
  234.  
  235. 'Bumpers
  236. Sub Bumper1_Hit:vpmTimer.PulseSw 11 : playsound SoundFX("fx_bumper1",DOFContactors) : End Sub
  237. Sub Bumper2_Hit:vpmTimer.PulseSw 40 : playsound SoundFXDOF("fx_bumper2", 111, DOFPulse, DOFContactors) : End Sub
  238. Sub Bumper3_Hit:vpmTimer.PulseSw 40 : playsound SoundFXDOF("fx_bumper3", 112, DOFPulse, DOFContactors) : End Sub
  239.  
  240. 'Gates
  241. Sub Gate1_Hit:playsound "Gate5":End Sub
  242. Sub Gate2_Hit:playsound "Gate5":End Sub
  243. Sub Gate3_Hit:playsound "Gate5":End Sub
  244. Sub Gate4_Hit:playsound "Gate5":End Sub
  245.  
  246. '**********Sling Shot Animations
  247. ' Rstep and Lstep are the variables that increment the animation
  248. '****************
  249. Dim RStep, Lstep
  250.  
  251. Sub RightSlingShot_Slingshot
  252. vpmTimer.PulseSw 10
  253. PlaySound SoundFXDOF("left_slingshot", 110, DOFPulse, DOFContactors), 0, 1, 0.05, 0.05
  254. RSling.Visible = 0
  255. RSling1.Visible = 1
  256. sling1.TransZ = -20
  257. RStep = 0
  258. RightSlingShot.TimerEnabled = 1
  259. End Sub
  260.  
  261. Sub RightSlingShot_Timer
  262. Select Case RStep
  263. Case 3:RSLing1.Visible = 0:RSLing2.Visible = 1:sling1.TransZ = -10
  264. Case 4:RSLing2.Visible = 0:RSLing.Visible = 1:sling1.TransZ = 0:RightSlingShot.TimerEnabled = 0:
  265. End Select
  266. RStep = RStep + 1
  267. End Sub
  268.  
  269. Sub LeftSlingShot_Slingshot
  270. vpmTimer.PulseSw 10
  271. PlaySound SoundFXDOF("right_slingshot", 109, DOFPulse, DOFContactors),0,1,-0.05,0.05
  272. LSling.Visible = 0
  273. LSling1.Visible = 1
  274. sling2.TransZ = -20
  275. LStep = 0
  276. LeftSlingShot.TimerEnabled = 1
  277. End Sub
  278.  
  279. Sub LeftSlingShot_Timer
  280. Select Case LStep
  281. Case 3:LSLing1.Visible = 0:LSLing2.Visible = 1:sling2.TransZ = -10
  282. Case 4:LSLing2.Visible = 0:LSLing.Visible = 1:sling2.TransZ = 0:LeftSlingShot.TimerEnabled = 0:
  283. End Select
  284. LStep = LStep + 1
  285. End Sub
  286.  
  287.  
  288. '**********************************************************************************************************
  289.  
  290. 'Map lights to an array
  291. '**********************************************************************************************************
  292. 'Set Lights(1)=Light1 'Game Over
  293. 'Set Lights(2)=Light2 'Tilt
  294. 'Set Lights(3)=Light3 'High Score
  295. Set Lights(4)=Light4
  296. Set Lights(5)=Light5
  297. Set Lights(6)=Light6
  298. Set Lights(7)=Light7
  299. Set Lights(8)=Light8
  300. Set Lights(9)=Light9
  301. Set Lights(10)=Light10
  302. Set Lights(11)=Light11
  303. Set Lights(12)=Light12
  304. Set Lights(13)=Light13
  305. Set Lights(14)=Light14
  306. Set Lights(15)=Light15
  307. Set Lights(16)=Light16
  308. Set Lights(17)=Light17
  309. Set Lights(18)=Light18
  310. Set Lights(19)=Light19
  311. Set Lights(20)=Light20
  312. Set Lights(21)=Light21
  313. Set Lights(22)=Light22
  314. Set Lights(23)=Light23
  315. Set Lights(24)=Light24
  316. Set Lights(25)=Light25
  317. Lights(26)=array(Light26,Light26_1,Light26_2)
  318. Set Lights(28)=Light28
  319. Set Lights(29)=Light29
  320. Set Lights(30)=Light30
  321. Set Lights(31)=Light31
  322. Set Lights(32)=Light32
  323. Set Lights(33)=Light33
  324. Set Lights(34)=Light34
  325. Set Lights(35)=Light35
  326. '**********************************************************************************************************
  327.  
  328. 'backglass lamps
  329. '*********************************************************************************************************
  330. Dim Digits(32)
  331. Digits(0)=Array(a00,a01,a02,a03,a04,a05,a06,n,a08)
  332. Digits(1)=Array(a10,a11,a12,a13,a14,a15,a16,n,a18)
  333. Digits(2)=Array(a20,a21,a22,a23,a24,a25,a26,n,a28)
  334. Digits(3)=Array(a30,a31,a32,a33,a34,a35,a36,n,a38)
  335. Digits(4)=Array(a40,a41,a42,a43,a44,a45,a46,n,a48)
  336. Digits(5)=Array(a50,a51,a52,a53,a54,a55,a56,n,a58)
  337. Digits(6)=Array(b00,b01,b02,b03,b04,b05,b06,n,b08)
  338. Digits(7)=Array(b10,b11,b12,b13,b14,b15,b16,n,b18)
  339. Digits(8)=Array(b20,b21,b22,b23,b24,b25,b26,n,b28)
  340. Digits(9)=Array(b30,b31,b32,b33,b34,b35,b36,n,b38)
  341. Digits(10)=Array(b40,b41,b42,b43,b44,b45,b46,n,b48)
  342. Digits(11)=Array(b50,b51,b52,b53,b54,b55,b56,n,b58)
  343. Digits(12)=Array(c00,c01,c02,c03,c04,c05,c06,n,c08)
  344. Digits(13)=Array(c10,c11,c12,c13,c14,c15,c16,n,c18)
  345. Digits(14)=Array(c20,c21,c22,c23,c24,c25,c26,n,c28)
  346. Digits(15)=Array(c30,c31,c32,c33,c34,c35,c36,n,c38)
  347. Digits(16)=Array(c40,c41,c42,c43,c44,c45,c46,n,c48)
  348. Digits(17)=Array(c50,c51,c52,c53,c54,c55,c56,n,c58)
  349. Digits(18)=Array(d00,d01,d02,d03,d04,d05,d06,n,d08)
  350. Digits(19)=Array(d10,d11,d12,d13,d14,d15,d16,n,d18)
  351. Digits(20)=Array(d20,d21,d22,d23,d24,d25,d26,n,d28)
  352. Digits(21)=Array(d30,d31,d32,d33,d34,d35,d36,n,d38)
  353. Digits(22)=Array(d40,d41,d42,d43,d44,d45,d46,n,d48)
  354. Digits(23)=Array(d50,d51,d52,d53,d54,d55,d56,n,d58)
  355. Digits(26)=Array(e00,e01,e02,e03,e04,e05,e06,n,e08)
  356. Digits(27)=Array(e10,e11,e12,e13,e14,e15,e16,n,e18)
  357. Digits(24)=Array(f00,f01,f02,f03,f04,f05,f06,n,f08)
  358. Digits(25)=Array(f10,f11,f12,f13,f14,f15,f16,n,f18)
  359.  
  360. Sub DisplayTimer_Timer
  361. Dim ChgLED,ii,num,chg,stat,obj
  362. ChgLed = Controller.ChangedLEDs(&Hffffffff, &Hffffffff)
  363. If Not IsEmpty(ChgLED) Then
  364. If DesktopMode = True Then
  365. For ii = 0 To UBound(chgLED)
  366. num = chgLED(ii, 0) : chg = chgLED(ii, 1) : stat = chgLED(ii, 2)
  367. if (num < 32) then
  368. For Each obj In Digits(num)
  369. If chg And 1 Then obj.State = stat And 1
  370. chg = chg\2 : stat = stat\2
  371. Next
  372. else
  373. end if
  374. next
  375. end if
  376. end if
  377. End Sub
  378.  
  379. '**********************************************************************************************************
  380. 'Gottlieb System 1
  381. 'added by Inkochnito
  382. Sub editDips
  383. Dim vpmDips : Set vpmDips = New cvpmDips
  384. With vpmDips
  385. .AddForm 700,400,"System 1 - DIP switches"
  386. .AddFrame 205,0,190,"Maximum credits",&H00030000,Array("5 credits",0,"8 credits",&H00020000,"10 credits",&H00010000,"15 credits",&H00030000)'dip 17&18
  387. .AddFrame 0,0,190,"Coin chute control",&H00040000,Array("seperate",0,"same",&H00040000)'dip 19
  388. .AddFrame 0,46,190,"Game mode",&H00000400,Array("extra ball",0,"replay",&H00000400)'dip 11
  389. .AddFrame 0,92,190,"High game to date awards",&H00200000,Array("no award",0,"3 replays",&H00200000)'dip 22
  390. .AddFrame 0,138,190,"Balls per game",&H00000100,Array("5 balls",0,"3 balls",&H00000100)'dip 9
  391. .AddFrame 0,184,190,"Tilt effect",&H00000800,Array("game over",0,"ball in play only",&H00000800)'dip 12
  392. .AddChk 205,80,190,Array("Match feature",&H00000200)'dip 10
  393. .AddChk 205,95,190,Array("Credits displayed",&H00001000)'dip 13
  394. .AddChk 205,110,190,Array("Play credit button tune",&H00002000)'dip 14
  395. .AddChk 205,125,190,Array("Play tones when scoring",&H00080000)'dip 20
  396. .AddChk 205,140,190,Array("Play coin switch tune",&H00400000)'dip 23
  397. .AddChk 205,155,190,Array("High game to date displayed",&H00100000)'dip 21
  398. .AddLabel 50,240,300,20,"After hitting OK, press F3 to reset game with new settings."
  399. .ViewDips
  400. End With
  401. End Sub
  402. Set vpmShowDips = GetRef("editDips")
  403.  
  404.  
  405. '*********************************************************************
  406. ' Positional Sound Playback Functions
  407. '*********************************************************************
  408.  
  409. ' Play a sound, depending on the X,Y position of the table element (especially cool for surround speaker setups, otherwise stereo panning only)
  410. ' parameters (defaults): loopcount (1), volume (1), randompitch (0), pitch (0), useexisting (0), restart (1))
  411. ' Note that this will not work (currently) for walls/slingshots as these do not feature a simple, single X,Y position
  412. Sub PlayXYSound(soundname, tableobj, loopcount, volume, randompitch, pitch, useexisting, restart)
  413. PlaySound soundname, loopcount, volume, AudioPan(tableobj), randompitch, pitch, useexisting, restart, AudioFade(tableobj)
  414. End Sub
  415.  
  416. ' Similar subroutines that are less complicated to use (e.g. simply use standard parameters for the PlaySound call)
  417. Sub PlaySoundAt(soundname, tableobj)
  418. PlaySound soundname, 1, 1, AudioPan(tableobj), 0,0,0, 1, AudioFade(tableobj)
  419. End Sub
  420.  
  421. Sub PlaySoundAtBall(soundname)
  422. PlaySoundAt soundname, ActiveBall
  423. End Sub
  424.  
  425.  
  426. '*********************************************************************
  427. ' Supporting Ball & Sound Functions
  428. '*********************************************************************
  429.  
  430. 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
  431. Dim tmp
  432. tmp = tableobj.y * 2 / table1.height-1
  433. If tmp > 0 Then
  434. AudioFade = Csng(tmp ^10)
  435. Else
  436. AudioFade = Csng(-((- tmp) ^10) )
  437. End If
  438. End Function
  439.  
  440. Function AudioPan(tableobj) ' Calculates the pan for a tableobj based on the X position on the table. "table1" is the name of the table
  441. Dim tmp
  442. tmp = tableobj.x * 2 / table1.width-1
  443. If tmp > 0 Then
  444. AudioPan = Csng(tmp ^10)
  445. Else
  446. AudioPan = Csng(-((- tmp) ^10) )
  447. End If
  448. End Function
  449.  
  450. Function Vol(ball) ' Calculates the Volume of the sound based on the ball speed
  451. Vol = Csng(BallVel(ball) ^2 / 2000)
  452. End Function
  453.  
  454. Function Pitch(ball) ' Calculates the pitch of the sound based on the ball speed
  455. Pitch = BallVel(ball) * 20
  456. End Function
  457.  
  458. Function BallVel(ball) 'Calculates the ball speed
  459. BallVel = INT(SQR((ball.VelX ^2) + (ball.VelY ^2) ) )
  460. End Function
  461.  
  462.  
  463. '********************************************************************
  464. ' JP's VP10 Rolling Sounds (+rothbauerw's Dropping Sounds)
  465. '********************************************************************
  466.  
  467. Const tnob = 5 ' total number of balls
  468. ReDim rolling(tnob)
  469. InitRolling
  470.  
  471. Sub InitRolling
  472. Dim i
  473. For i = 0 to tnob
  474. rolling(i) = False
  475. Next
  476. End Sub
  477.  
  478. Sub RollingTimer_Timer()
  479. Dim BOT, b
  480. BOT = GetBalls
  481.  
  482. ' stop the sound of deleted balls
  483. For b = UBound(BOT) + 1 to tnob
  484. rolling(b) = False
  485. StopSound("fx_ballrolling" & b)
  486. Next
  487.  
  488. ' exit the sub if no balls on the table
  489. If UBound(BOT) = -1 Then Exit Sub
  490.  
  491. For b = 0 to UBound(BOT)
  492. ' play the rolling sound for each ball
  493. If BallVel(BOT(b) ) > 1 AND BOT(b).z < 30 Then
  494. rolling(b) = True
  495. PlaySound("fx_ballrolling" & b), -1, Vol(BOT(b)), AudioPan(BOT(b)), 0, Pitch(BOT(b)), 1, 0, AudioFade(BOT(b))
  496. Else
  497. If rolling(b) = True Then
  498. StopSound("fx_ballrolling" & b)
  499. rolling(b) = False
  500. End If
  501. End If
  502.  
  503. ' play ball drop sounds
  504. If BOT(b).VelZ < -1 and BOT(b).z < 55 and BOT(b).z > 27 Then 'height adjust for ball drop sounds
  505. PlaySound "fx_ball_drop" & b, 0, ABS(BOT(b).velz)/17, AudioPan(BOT(b)), 0, Pitch(BOT(b)), 1, 0, AudioFade(BOT(b))
  506. End If
  507. Next
  508. End Sub
  509.  
  510. '**********************
  511. ' Ball Collision Sound
  512. '**********************
  513.  
  514. Sub OnBallBallCollision(ball1, ball2, velocity)
  515. PlaySound("fx_collide"), 0, Csng(velocity) ^2 / 2000, AudioPan(ball1), 0, Pitch(ball1), 0, 0, AudioFade(ball1)
  516. End Sub
  517.  
  518.  
  519. '*************
  520. ' JP'S LUT
  521. '*************
  522.  
  523. Dim bLutActive, LUTImage
  524. Sub LoadLUT
  525. Dim x
  526. x = LoadValue(cGameName, "LUTImage")
  527. If(x <> "") Then LUTImage = x Else LUTImage = 0
  528. UpdateLUT
  529. End Sub
  530.  
  531. Sub SaveLUT
  532. SaveValue cGameName, "LUTImage", LUTImage
  533. End Sub
  534.  
  535. Sub NextLUT: LUTImage = (LUTImage +1 ) MOD 10: UpdateLUT: SaveLUT: End Sub
  536.  
  537. Sub UpdateLUT
  538. Select Case LutImage
  539. Case 0: table1.ColorGradeImage = "LUT0"
  540. Case 1: table1.ColorGradeImage = "LUT1"
  541. Case 2: table1.ColorGradeImage = "LUT2"
  542. Case 3: table1.ColorGradeImage = "LUT3"
  543. Case 4: table1.ColorGradeImage = "LUT4"
  544. Case 5: table1.ColorGradeImage = "LUT5"
  545. Case 6: table1.ColorGradeImage = "LUT6"
  546. Case 7: table1.ColorGradeImage = "LUT7"
  547. Case 8: table1.ColorGradeImage = "LUT8"
  548. Case 9: table1.ColorGradeImage = "LUT9"
  549.  
  550. End Select
  551. End Sub
  552.  
  553.  
  554. '*****************************************
  555. ' ninuzzu's FLIPPER SHADOWS
  556. '*****************************************
  557.  
  558. sub FlipperTimer_Timer()
  559. FlipperLSh.RotZ = LeftFlipper.currentangle
  560. FlipperRSh.RotZ = RightFlipper.currentangle
  561. LFlip.RotZ = LeftFlipper.CurrentAngle
  562. RFlip.RotZ= RightFlipper.CurrentAngle
  563. End Sub
  564.  
  565. '*****************************************
  566. ' ninuzzu's BALL SHADOW
  567. '*****************************************
  568.  
  569. Dim BallShadow
  570. BallShadow = Array (BallShadow1,BallShadow2,BallShadow3,BallShadow4,BallShadow5)
  571.  
  572. Sub BallShadowUpdate_timer()
  573. Dim BOT, b
  574. BOT = GetBalls
  575. ' hide shadow of deleted balls
  576. If UBound(BOT)<(tnob-1) Then
  577. For b = (UBound(BOT) + 1) to (tnob-1)
  578. BallShadow(b).visible = 0
  579. Next
  580. End If
  581. ' exit the Sub if no balls on the table
  582. If UBound(BOT) = -1 Then Exit Sub
  583. ' render the shadow for each ball
  584. For b = 0 to UBound(BOT)
  585. If BOT(b).X < Table1.Width/2 Then
  586. BallShadow(b).X = ((BOT(b).X) - (Ballsize/6) + ((BOT(b).X - (Table1.Width/2))/21)) + 6
  587. Else
  588. BallShadow(b).X = ((BOT(b).X) + (Ballsize/6) + ((BOT(b).X - (Table1.Width/2))/21)) - 6
  589. End If
  590. ballShadow(b).Y = BOT(b).Y + 4
  591. If BOT(b).Z > 20 Then
  592. BallShadow(b).visible = 1
  593. Else
  594. BallShadow(b).visible = 0
  595. End If
  596. Next
  597. End Sub
  598.  
  599.  
  600. '************************************
  601. ' What you need to add to your table
  602. '************************************
  603.  
  604. ' a timer called RollingTimer. With a fast interval, like 10
  605. ' one collision sound, in this script is called fx_collide
  606. ' as many sound files as max number of balls, with names ending with 0, 1, 2, 3, etc
  607. ' for ex. as used in this script: fx_ballrolling0, fx_ballrolling1, fx_ballrolling2, fx_ballrolling3, etc
  608.  
  609.  
  610. '******************************************
  611. ' Explanation of the rolling sound routine
  612. '******************************************
  613.  
  614. ' sounds are played based on the ball speed and position
  615.  
  616. ' the routine checks first for deleted balls and stops the rolling sound.
  617.  
  618. ' The For loop goes through all the balls on the table and checks for the ball speed and
  619. ' if the ball is on the table (height lower than 30) then then it plays the sound
  620. ' otherwise the sound is stopped, like when the ball has stopped or is on a ramp or flying.
  621.  
  622. ' The sound is played using the VOL, AUDIOPAN, AUDIOFADE and PITCH functions, so the volume and pitch of the sound
  623. ' will change according to the ball speed, and the AUDIOPAN & AUDIOFADE functions will change the stereo position
  624. ' according to the position of the ball on the table.
  625.  
  626.  
  627. '**************************************
  628. ' Explanation of the collision routine
  629. '**************************************
  630.  
  631. ' The collision is built in VP.
  632. ' You only need to add a Sub OnBallBallCollision(ball1, ball2, velocity) and when two balls collide they
  633. ' 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
  634. ' depending of the speed of the collision.
  635.  
  636.  
  637. Sub Pins_Hit (idx)
  638. PlaySound "pinhit_low", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall)
  639. End Sub
  640.  
  641. Sub Targets_Hit (idx)
  642. PlaySound "target", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall)
  643. End Sub
  644.  
  645. Sub Metals_Thin_Hit (idx)
  646. PlaySound "metalhit_thin", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  647. End Sub
  648.  
  649. Sub Metals_Medium_Hit (idx)
  650. PlaySound "metalhit_medium", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  651. End Sub
  652.  
  653. Sub Metals2_Hit (idx)
  654. PlaySound "metalhit2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  655. End Sub
  656.  
  657. Sub Gates_Hit (idx)
  658. PlaySound "Gate5", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  659. End Sub
  660.  
  661. Sub Spinner_Spin
  662. PlaySound "fx_spinner", 0, .25, AudioPan(Spinner), 0.25, 0, 0, 1, AudioFade(Spinner)
  663. End Sub
  664.  
  665. Sub Rubbers_Hit(idx)
  666. dim finalspeed
  667. finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
  668. If finalspeed > 20 then
  669. PlaySound "fx_rubber2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  670. End if
  671. If finalspeed >= 6 AND finalspeed <= 20 then
  672. RandomSoundRubber()
  673. End If
  674. End Sub
  675.  
  676. Sub Posts_Hit(idx)
  677. dim finalspeed
  678. finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
  679. If finalspeed > 16 then
  680. PlaySound "fx_rubber2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  681. End if
  682. If finalspeed >= 6 AND finalspeed <= 16 then
  683. RandomSoundRubber()
  684. End If
  685. End Sub
  686.  
  687. Sub RandomSoundRubber()
  688. Select Case Int(Rnd*3)+1
  689. Case 1 : PlaySound "rubber_hit_1", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  690. Case 2 : PlaySound "rubber_hit_2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  691. Case 3 : PlaySound "rubber_hit_3", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  692. End Select
  693. End Sub
  694.  
  695. Sub LeftFlipper_Collide(parm)
  696. RandomSoundFlipper()
  697. End Sub
  698.  
  699. Sub RightFlipper_Collide(parm)
  700. RandomSoundFlipper()
  701. End Sub
  702.  
  703. Sub RandomSoundFlipper()
  704. Select Case Int(Rnd*3)+1
  705. Case 1 : PlaySound "flip_hit_1", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  706. Case 2 : PlaySound "flip_hit_2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  707. Case 3 : PlaySound "flip_hit_3", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
  708. End Select
  709. End Sub
  710.  
  711. '******************************************************
  712. ' FLIPPER CORRECTION INITIALIZATION
  713. ' Start nFOZZY FLIPPERS'
  714. '******************************************************
  715.  
  716. 'Flipper Correction Initialization late 80’s to early 90’s
  717. dim LF : Set LF = New FlipperPolarity
  718. dim RF : Set RF = New FlipperPolarity
  719.  
  720. InitPolarity
  721.  
  722. Sub InitPolarity()
  723. dim x, a : a = Array(LF, RF)
  724. for each x in a
  725. x.AddPoint "Ycoef", 0, RightFlipper.Y-65, 1 'disabled
  726. x.AddPoint "Ycoef", 1, RightFlipper.Y-11, 1
  727. x.enabled = True
  728. x.TimeDelay = 60
  729. Next
  730.  
  731. AddPt "Polarity", 0, 0, 0
  732. AddPt "Polarity", 1, 0.05, -5
  733. AddPt "Polarity", 2, 0.4, -5
  734. AddPt "Polarity", 3, 0.6, -4.5
  735. AddPt "Polarity", 4, 0.65, -4.0
  736. AddPt "Polarity", 5, 0.7, -3.5
  737. AddPt "Polarity", 6, 0.75, -3.0
  738. AddPt "Polarity", 7, 0.8, -2.5
  739. AddPt "Polarity", 8, 0.85, -2.0
  740. AddPt "Polarity", 9, 0.9,-1.5
  741. AddPt "Polarity", 10, 0.95, -1.0
  742. AddPt "Polarity", 11, 1, -0.5
  743. AddPt "Polarity", 12, 1.1, 0
  744. AddPt "Polarity", 13, 1.3, 0
  745.  
  746. addpt "Velocity", 0, 0, 1
  747. addpt "Velocity", 1, 0.16, 1.06
  748. addpt "Velocity", 2, 0.41, 1.05
  749. addpt "Velocity", 3, 0.53, 1'0.982
  750. addpt "Velocity", 4, 0.702, 0.968
  751. addpt "Velocity", 5, 0.95, 0.968
  752. addpt "Velocity", 6, 1.03, 0.945
  753.  
  754. LF.Object = LeftFlipper
  755. LF.EndPoint = EndPointLp
  756. RF.Object = RightFlipper
  757. RF.EndPoint = EndPointRp
  758. End Sub
  759.  
  760. Sub TriggerLF_Hit() : LF.Addball activeball : End Sub
  761. Sub TriggerLF_UnHit() : LF.PolarityCorrect activeball : End Sub
  762. Sub TriggerRF_Hit() : RF.Addball activeball : End Sub
  763. Sub TriggerRF_UnHit() : RF.PolarityCorrect activeball : End Sub
  764.  
  765. '******************************************************
  766. ' FLIPPER CORRECTION FUNCTIONS
  767. '******************************************************
  768.  
  769. Sub AddPt(aStr, idx, aX, aY) 'debugger wrapper for adjusting flipper script in-game
  770. dim a : a = Array(LF, RF)
  771. dim x : for each x in a
  772. x.addpoint aStr, idx, aX, aY
  773. Next
  774. End Sub
  775.  
  776. Class FlipperPolarity
  777. Public DebugOn, Enabled
  778. Private FlipAt 'Timer variable (IE 'flip at 723,530ms...)
  779. Public TimeDelay 'delay before trigger turns off and polarity is disabled TODO set time!
  780. private Flipper, FlipperStart,FlipperEnd, FlipperEndY, LR, PartialFlipCoef
  781. Private Balls(20), balldata(20)
  782.  
  783. dim PolarityIn, PolarityOut
  784. dim VelocityIn, VelocityOut
  785. dim YcoefIn, YcoefOut
  786. Public Sub Class_Initialize
  787. redim PolarityIn(0) : redim PolarityOut(0) : redim VelocityIn(0) : redim VelocityOut(0) : redim YcoefIn(0) : redim YcoefOut(0)
  788. Enabled = True : TimeDelay = 50 : LR = 1: dim x : for x = 0 to uBound(balls) : balls(x) = Empty : set Balldata(x) = new SpoofBall : next
  789. End Sub
  790.  
  791. Public Property let Object(aInput) : Set Flipper = aInput : StartPoint = Flipper.x : End Property
  792. Public Property Let StartPoint(aInput) : if IsObject(aInput) then FlipperStart = aInput.x else FlipperStart = aInput : end if : End Property
  793. Public Property Get StartPoint : StartPoint = FlipperStart : End Property
  794. Public Property Let EndPoint(aInput) : FlipperEnd = aInput.x: FlipperEndY = aInput.y: End Property
  795. Public Property Get EndPoint : EndPoint = FlipperEnd : End Property
  796. Public Property Get EndPointY: EndPointY = FlipperEndY : End Property
  797.  
  798. Public Sub AddPoint(aChooseArray, aIDX, aX, aY) 'Index #, X position, (in) y Position (out)
  799. Select Case aChooseArray
  800. case "Polarity" : ShuffleArrays PolarityIn, PolarityOut, 1 : PolarityIn(aIDX) = aX : PolarityOut(aIDX) = aY : ShuffleArrays PolarityIn, PolarityOut, 0
  801. Case "Velocity" : ShuffleArrays VelocityIn, VelocityOut, 1 :VelocityIn(aIDX) = aX : VelocityOut(aIDX) = aY : ShuffleArrays VelocityIn, VelocityOut, 0
  802. Case "Ycoef" : ShuffleArrays YcoefIn, YcoefOut, 1 :YcoefIn(aIDX) = aX : YcoefOut(aIDX) = aY : ShuffleArrays YcoefIn, YcoefOut, 0
  803. End Select
  804. if gametime > 100 then Report aChooseArray
  805. End Sub
  806.  
  807. Public Sub Report(aChooseArray) 'debug, reports all coords in tbPL.text
  808. if not DebugOn then exit sub
  809. dim a1, a2 : Select Case aChooseArray
  810. case "Polarity" : a1 = PolarityIn : a2 = PolarityOut
  811. Case "Velocity" : a1 = VelocityIn : a2 = VelocityOut
  812. Case "Ycoef" : a1 = YcoefIn : a2 = YcoefOut
  813. case else :tbpl.text = "wrong string" : exit sub
  814. End Select
  815. dim str, x : for x = 0 to uBound(a1) : str = str & aChooseArray & " x: " & round(a1(x),4) & ", " & round(a2(x),4) & vbnewline : next
  816. tbpl.text = str
  817. End Sub
  818.  
  819. Public Sub AddBall(aBall) : dim x : for x = 0 to uBound(balls) : if IsEmpty(balls(x)) then set balls(x) = aBall : exit sub :end if : Next : End Sub
  820.  
  821. Private Sub RemoveBall(aBall)
  822. dim x : for x = 0 to uBound(balls)
  823. if TypeName(balls(x) ) = "IBall" then
  824. if aBall.ID = Balls(x).ID Then
  825. balls(x) = Empty
  826. Balldata(x).Reset
  827. End If
  828. End If
  829. Next
  830. End Sub
  831.  
  832. Public Sub Fire()
  833. Flipper.RotateToEnd
  834. processballs
  835. End Sub
  836.  
  837. Public Property Get Pos 'returns % position a ball. For debug stuff.
  838. dim x : for x = 0 to uBound(balls)
  839. if not IsEmpty(balls(x) ) then
  840. pos = pSlope(Balls(x).x, FlipperStart, 0, FlipperEnd, 1)
  841. End If
  842. Next
  843. End Property
  844.  
  845. Public Sub ProcessBalls() 'save data of balls in flipper range
  846. FlipAt = GameTime
  847. dim x : for x = 0 to uBound(balls)
  848. if not IsEmpty(balls(x) ) then
  849. balldata(x).Data = balls(x)
  850. End If
  851. Next
  852. PartialFlipCoef = ((Flipper.StartAngle - Flipper.CurrentAngle) / (Flipper.StartAngle - Flipper.EndAngle))
  853. PartialFlipCoef = abs(PartialFlipCoef-1)
  854. End Sub
  855. Private Function FlipperOn() : if gameTime < FlipAt+TimeDelay then FlipperOn = True : End If : End Function 'Timer shutoff for polaritycorrect
  856.  
  857. Public Sub PolarityCorrect(aBall)
  858. if FlipperOn() then
  859. dim tmp, BallPos, x, IDX, Ycoef : Ycoef = 1
  860.  
  861. 'y safety Exit
  862. if aBall.VelY > -8 then 'ball going down
  863. RemoveBall aBall
  864. exit Sub
  865. end if
  866.  
  867. 'Find balldata. BallPos = % on Flipper
  868. for x = 0 to uBound(Balls)
  869. if aBall.id = BallData(x).id AND not isempty(BallData(x).id) then
  870. idx = x
  871. BallPos = PSlope(BallData(x).x, FlipperStart, 0, FlipperEnd, 1)
  872. if ballpos > 0.65 then Ycoef = LinearEnvelope(BallData(x).Y, YcoefIn, YcoefOut) 'find safety coefficient 'ycoef' data
  873. end if
  874. Next
  875.  
  876. If BallPos = 0 Then 'no ball data meaning the ball is entering and exiting pretty close to the same position, use current values.
  877. BallPos = PSlope(aBall.x, FlipperStart, 0, FlipperEnd, 1)
  878. if ballpos > 0.65 then Ycoef = LinearEnvelope(aBall.Y, YcoefIn, YcoefOut) 'find safety coefficient 'ycoef' data
  879. End If
  880.  
  881. 'Velocity correction
  882. if not IsEmpty(VelocityIn(0) ) then
  883. Dim VelCoef
  884. : VelCoef = LinearEnvelope(BallPos, VelocityIn, VelocityOut)
  885.  
  886. if partialflipcoef < 1 then VelCoef = PSlope(partialflipcoef, 0, 1, 1, VelCoef)
  887.  
  888. if Enabled then aBall.Velx = aBall.Velx*VelCoef
  889. if Enabled then aBall.Vely = aBall.Vely*VelCoef
  890. End If
  891.  
  892. 'Polarity Correction (optional now)
  893. if not IsEmpty(PolarityIn(0) ) then
  894. If StartPoint > EndPoint then LR = -1 'Reverse polarity if left flipper
  895. dim AddX : AddX = LinearEnvelope(BallPos, PolarityIn, PolarityOut) * LR
  896.  
  897. if Enabled then aBall.VelX = aBall.VelX + 1 * (AddX*ycoef*PartialFlipcoef)
  898. 'playsound "fx_knocker"
  899. End If
  900. End If
  901. RemoveBall aBall
  902. End Sub
  903. End Class
  904.  
  905. '******************************************************
  906. ' FLIPPER POLARITY AND RUBBER DAMPENER
  907. ' SUPPORTING FUNCTIONS
  908. '******************************************************
  909.  
  910. ' Used for flipper correction and rubber dampeners
  911. Sub ShuffleArray(ByRef aArray, byVal offset) 'shuffle 1d array
  912. dim x, aCount : aCount = 0
  913. redim a(uBound(aArray) )
  914. for x = 0 to uBound(aArray) 'Shuffle objects in a temp array
  915. if not IsEmpty(aArray(x) ) Then
  916. if IsObject(aArray(x)) then
  917. Set a(aCount) = aArray(x)
  918. Else
  919. a(aCount) = aArray(x)
  920. End If
  921. aCount = aCount + 1
  922. End If
  923. Next
  924. if offset < 0 then offset = 0
  925. redim aArray(aCount-1+offset) 'Resize original array
  926. for x = 0 to aCount-1 'set objects back into original array
  927. if IsObject(a(x)) then
  928. Set aArray(x) = a(x)
  929. Else
  930. aArray(x) = a(x)
  931. End If
  932. Next
  933. End Sub
  934.  
  935. ' Used for flipper correction and rubber dampeners
  936. Sub ShuffleArrays(aArray1, aArray2, offset)
  937. ShuffleArray aArray1, offset
  938. ShuffleArray aArray2, offset
  939. End Sub
  940.  
  941. ' Used for flipper correction, rubber dampeners, and drop targets
  942. Function BallSpeed(ball) 'Calculates the ball speed
  943. BallSpeed = SQR(ball.VelX^2 + ball.VelY^2 + ball.VelZ^2)
  944. End Function
  945.  
  946. ' Used for flipper correction and rubber dampeners
  947. Function PSlope(Input, X1, Y1, X2, Y2) 'Set up line via two points, no clamping. Input X, output Y
  948. dim x, y, b, m : x = input : m = (Y2 - Y1) / (X2 - X1) : b = Y2 - m*X2
  949. Y = M*x+b
  950. PSlope = Y
  951. End Function
  952.  
  953. ' Used for flipper correction
  954. Class spoofball
  955. Public X, Y, Z, VelX, VelY, VelZ, ID, Mass, Radius
  956. Public Property Let Data(aBall)
  957. With aBall
  958. x = .x : y = .y : z = .z : velx = .velx : vely = .vely : velz = .velz
  959. id = .ID : mass = .mass : radius = .radius
  960. end with
  961. End Property
  962. Public Sub Reset()
  963. x = Empty : y = Empty : z = Empty : velx = Empty : vely = Empty : velz = Empty
  964. id = Empty : mass = Empty : radius = Empty
  965. End Sub
  966. End Class
  967.  
  968. ' Used for flipper correction and rubber dampeners
  969. Function LinearEnvelope(xInput, xKeyFrame, yLvl)
  970. dim y 'Y output
  971. dim L 'Line
  972. dim ii : for ii = 1 to uBound(xKeyFrame) 'find active line
  973. if xInput <= xKeyFrame(ii) then L = ii : exit for : end if
  974. Next
  975. if xInput > xKeyFrame(uBound(xKeyFrame) ) then L = uBound(xKeyFrame) 'catch line overrun
  976. Y = pSlope(xInput, xKeyFrame(L-1), yLvl(L-1), xKeyFrame(L), yLvl(L) )
  977.  
  978. if xInput <= xKeyFrame(lBound(xKeyFrame) ) then Y = yLvl(lBound(xKeyFrame) ) 'Clamp lower
  979. if xInput >= xKeyFrame(uBound(xKeyFrame) ) then Y = yLvl(uBound(xKeyFrame) ) 'Clamp upper
  980.  
  981. LinearEnvelope = Y
  982. End Function
  983.  
  984. ' Used for drop targets and stand up targets
  985. Function Atn2(dy, dx)
  986. dim pi
  987. pi = 4*Atn(1)
  988.  
  989. If dx > 0 Then
  990. Atn2 = Atn(dy / dx)
  991. ElseIf dx < 0 Then
  992. If dy = 0 Then
  993. Atn2 = pi
  994. Else
  995. Atn2 = Sgn(dy) * (pi - Atn(Abs(dy / dx)))
  996. end if
  997. ElseIf dx = 0 Then
  998. if dy = 0 Then
  999. Atn2 = 0
  1000. else
  1001. Atn2 = Sgn(dy) * pi / 2
  1002. end if
  1003. End If
  1004. End Function
  1005.  
  1006. ' Used for drop targets and flipper tricks
  1007. Function Distance(ax,ay,bx,by)
  1008. Distance = SQR((ax - bx)^2 + (ay - by)^2)
  1009. End Function
  1010.  
  1011. '******************************************************
  1012. ' FLIPPER TRICKS
  1013. '******************************************************
  1014.  
  1015. RightFlipper.timerinterval=1
  1016. Rightflipper.timerenabled=True
  1017.  
  1018. sub RightFlipper_timer()
  1019. FlipperTricks LeftFlipper, LFPress, LFCount, LFEndAngle, LFState
  1020. FlipperTricks RightFlipper, RFPress, RFCount, RFEndAngle, RFState
  1021. FlipperNudge RightFlipper, RFEndAngle, RFEOSNudge, LeftFlipper, LFEndAngle
  1022. FlipperNudge LeftFlipper, LFEndAngle, LFEOSNudge, RightFlipper, RFEndAngle
  1023. end sub
  1024.  
  1025. Dim LFEOSNudge, RFEOSNudge
  1026.  
  1027. Sub FlipperNudge(Flipper1, Endangle1, EOSNudge1, Flipper2, EndAngle2)
  1028. Dim BOT, b
  1029.  
  1030. If abs(Flipper1.currentangle) < abs(Endangle1) + 3 and EOSNudge1 <> 1 Then
  1031. EOSNudge1 = 1
  1032. If Flipper2.currentangle = EndAngle2 Then
  1033. BOT = GetBalls
  1034. For b = 0 to Ubound(BOT)
  1035. If FlipperTrigger(BOT(b).x, BOT(b).y, Flipper1) Then
  1036. 'Debug.Print "ball in flip1. exit"
  1037. exit Sub
  1038. end If
  1039. Next
  1040. For b = 0 to Ubound(BOT)
  1041. If FlipperTrigger(BOT(b).x, BOT(b).y, Flipper2) Then
  1042. 'debug.print "flippernudge!!"
  1043. BOT(b).velx = BOT(b).velx /1.5
  1044. BOT(b).vely = BOT(b).vely - 1
  1045. end If
  1046. Next
  1047. End If
  1048. Else
  1049. If abs(Flipper1.currentangle) > abs(Endangle1) + 30 then EOSNudge1 = 0
  1050. End If
  1051. End Sub
  1052.  
  1053. '*****************
  1054. ' Maths
  1055. '*****************
  1056. Const Pi = 3.1415927
  1057.  
  1058. Function dSin(degrees)
  1059. dsin = sin(degrees * Pi/180)
  1060. End Function
  1061.  
  1062. Function dCos(degrees)
  1063. dcos = cos(degrees * Pi/180)
  1064. End Function
  1065.  
  1066.  
  1067. '*************************************************
  1068. ' Check ball distance from Flipper for Rem
  1069. '*************************************************
  1070.  
  1071. Function Distance(ax,ay,bx,by)
  1072. Distance = SQR((ax - bx)^2 + (ay - by)^2)
  1073. End Function
  1074.  
  1075. Function DistancePL(px,py,ax,ay,bx,by) ' Distance between a point and a line where point is px,py
  1076. DistancePL = ABS((by - ay)*px - (bx - ax) * py + bx*ay - by*ax)/Distance(ax,ay,bx,by)
  1077. End Function
  1078.  
  1079. Function Radians(Degrees)
  1080. Radians = Degrees * PI /180
  1081. End Function
  1082.  
  1083. Function AnglePP(ax,ay,bx,by)
  1084. AnglePP = Atn2((by - ay),(bx - ax))*180/PI
  1085. End Function
  1086.  
  1087. Function DistanceFromFlipper(ballx, bally, Flipper)
  1088. DistanceFromFlipper = DistancePL(ballx, bally, Flipper.x, Flipper.y, Cos(Radians(Flipper.currentangle+90))+Flipper.x, Sin(Radians(Flipper.currentangle+90))+Flipper.y)
  1089. End Function
  1090.  
  1091. Function FlipperTrigger(ballx, bally, Flipper)
  1092. Dim DiffAngle
  1093. DiffAngle = ABS(Flipper.currentangle - AnglePP(Flipper.x, Flipper.y, ballx, bally) - 90)
  1094. If DiffAngle > 180 Then DiffAngle = DiffAngle - 360
  1095.  
  1096. If DistanceFromFlipper(ballx,bally,Flipper) < 48 and DiffAngle <= 90 and Distance(ballx,bally,Flipper.x,Flipper.y) < Flipper.Length Then
  1097. FlipperTrigger = True
  1098. Else
  1099. FlipperTrigger = False
  1100. End If
  1101. End Function
  1102.  
  1103. '*************************************************
  1104. ' End - Check ball distance from Flipper for Rem
  1105. '*************************************************
  1106.  
  1107.  
  1108.  
  1109. dim LFPress, RFPress, LFCount, RFCount
  1110. dim LFState, RFState
  1111. dim EOST, EOSA,Frampup, FElasticity,FReturn
  1112. dim RFEndAngle, LFEndAngle
  1113.  
  1114. EOST = leftflipper.eostorque
  1115. EOSA = leftflipper.eostorqueangle
  1116. Frampup = LeftFlipper.rampup
  1117. FElasticity = LeftFlipper.elasticity
  1118. FReturn = LeftFlipper.return
  1119. Const EOSTnew = 1 '0.8
  1120. Const EOSAnew = 1
  1121. Const EOSRampup = 0
  1122. Dim SOSRampup
  1123. Select Case FlipperCoilRampupMode
  1124. Case 0:
  1125. SOSRampup = 2.5
  1126. Case 1:
  1127. SOSRampup = 4.5
  1128. Case 2:
  1129. SOSRampup = 8.5
  1130. End Select
  1131. Const LiveCatch = 16
  1132. Const LiveElasticity = 0.45
  1133. Const SOSEM = 0.815
  1134. Const EOSReturn = 0.035 '0.025
  1135.  
  1136.  
  1137. LFEndAngle = Leftflipper.endangle
  1138. RFEndAngle = RightFlipper.endangle
  1139.  
  1140. Sub FlipperActivate(Flipper, FlipperPress)
  1141. FlipperPress = 1
  1142. Flipper.Elasticity = FElasticity
  1143.  
  1144. Flipper.eostorque = EOST
  1145. Flipper.eostorqueangle = EOSA
  1146. End Sub
  1147.  
  1148. Sub FlipperDeactivate(Flipper, FlipperPress)
  1149. FlipperPress = 0
  1150. Flipper.eostorqueangle = EOSA
  1151. Flipper.eostorque = EOST*EOSReturn/FReturn
  1152.  
  1153.  
  1154. If Abs(Flipper.currentangle) <= Abs(Flipper.endangle) + 0.1 Then
  1155. Dim BOT, b
  1156. BOT = GetBalls
  1157.  
  1158. For b = 0 to UBound(BOT)
  1159. If Distance(BOT(b).x, BOT(b).y, Flipper.x, Flipper.y) < 55 Then 'check for cradle
  1160. If BOT(b).vely >= -0.4 Then BOT(b).vely = -0.4
  1161. End If
  1162. Next
  1163. End If
  1164. End Sub
  1165.  
  1166. Sub FlipperTricks (Flipper, FlipperPress, FCount, FEndAngle, FState)
  1167. Dim Dir
  1168. Dir = Flipper.startangle/Abs(Flipper.startangle) '-1 for Right Flipper
  1169.  
  1170. If Abs(Flipper.currentangle) > Abs(Flipper.startangle) - 0.05 Then
  1171. If FState <> 1 Then
  1172. Flipper.rampup = SOSRampup
  1173. Flipper.endangle = FEndAngle - 3*Dir
  1174. Flipper.Elasticity = FElasticity * SOSEM
  1175. FCount = 0
  1176. FState = 1
  1177. End If
  1178. ElseIf Abs(Flipper.currentangle) <= Abs(Flipper.endangle) and FlipperPress = 1 then
  1179. if FCount = 0 Then FCount = GameTime
  1180.  
  1181. If FState <> 2 Then
  1182. Flipper.eostorqueangle = EOSAnew
  1183. Flipper.eostorque = EOSTnew
  1184. Flipper.rampup = EOSRampup
  1185. Flipper.endangle = FEndAngle
  1186. FState = 2
  1187. End If
  1188. Elseif Abs(Flipper.currentangle) > Abs(Flipper.endangle) + 0.01 and FlipperPress = 1 Then
  1189. If FState <> 3 Then
  1190. Flipper.eostorque = EOST
  1191. Flipper.eostorqueangle = EOSA
  1192. Flipper.rampup = Frampup
  1193. Flipper.Elasticity = FElasticity
  1194. FState = 3
  1195. End If
  1196.  
  1197. End If
  1198. End Sub
  1199.  
  1200. Const LiveDistanceMin = 30 'minimum distance in vp units from flipper base live catch dampening will occur
  1201. Const LiveDistanceMax = 117 'maximum distance in vp units from flipper base live catch dampening will occur (tip protection)
  1202.  
  1203. Sub CheckLiveCatch(ball, Flipper, FCount, parm) 'Experimental new live catch
  1204. Dim Dir
  1205. Dir = Flipper.startangle/Abs(Flipper.startangle) '-1 for Right Flipper
  1206. Dim LiveCatchBounce 'If live catch is not perfect, it won't freeze ball totally
  1207. Dim CatchTime : CatchTime = GameTime - FCount
  1208.  
  1209. if CatchTime <= LiveCatch and parm > 6 and ABS(Flipper.x - ball.x) > LiveDistanceMin and ABS(Flipper.x - ball.x) < LiveDistanceMax Then
  1210. if CatchTime <= LiveCatch*0.8 Then 'Perfect catch only when catch time happens in the beginning of the window
  1211. LiveCatchBounce = 0
  1212. else
  1213. LiveCatchBounce = Abs((LiveCatch/2) - CatchTime) 'Partial catch when catch happens a bit late
  1214. end If
  1215.  
  1216. 'debug.print "Live catch! Bounce: " & LiveCatchBounce
  1217.  
  1218. If LiveCatchBounce = 0 and ball.velx * Dir > 0 Then ball.velx = 0
  1219. ball.vely = LiveCatchBounce * (16 / LiveCatch) ' Multiplier for inaccuracy bounce
  1220. ball.angmomx= 0
  1221. ball.angmomy= 0
  1222. ball.angmomz= 0
  1223. End If
  1224. End Sub
  1225.  
  1226. '*****************************************************************************************************
  1227. 'END nFOZZY FLIPPERS'
  1228.  
  1229.  
  1230. 'PHYSICS DAMPENERS
  1231.  
  1232. 'These are data mined bounce curves,
  1233. 'dialed in with the in-game elasticity as much as possible to prevent angle / spin issues.
  1234. 'Requires tracking ballspeed to calculate COR
  1235.  
  1236. Sub dPosts_Hit(idx)
  1237. RubbersD.dampen Activeball
  1238. End Sub
  1239.  
  1240. Sub dSleeves_Hit(idx)
  1241. SleevesD.Dampen Activeball
  1242. End Sub
  1243.  
  1244.  
  1245. dim RubbersD : Set RubbersD = new Dampener 'frubber
  1246. RubbersD.name = "Rubbers"
  1247. RubbersD.debugOn = False 'shows info in textbox "TBPout"
  1248. RubbersD.Print = False 'debug, reports in debugger (in vel, out cor)
  1249. 'cor bounce curve (linear)
  1250. 'for best results, try to match in-game velocity as closely as possible to the desired curve
  1251. 'RubbersD.addpoint 0, 0, 0.935 'point# (keep sequential), ballspeed, CoR (elasticity)
  1252. RubbersD.addpoint 0, 0, 0.96 'point# (keep sequential), ballspeed, CoR (elasticity)
  1253. RubbersD.addpoint 1, 3.77, 0.96
  1254. RubbersD.addpoint 2, 5.76, 0.967 'dont take this as gospel. if you can data mine rubber elasticitiy, please help!
  1255. RubbersD.addpoint 3, 15.84, 0.874
  1256. RubbersD.addpoint 4, 56, 0.64 'there's clamping so interpolate up to 56 at least
  1257.  
  1258. dim SleevesD : Set SleevesD = new Dampener 'this is just rubber but cut down to 85%...
  1259. SleevesD.name = "Sleeves"
  1260. SleevesD.debugOn = False 'shows info in textbox "TBPout"
  1261. SleevesD.Print = False 'debug, reports in debugger (in vel, out cor)
  1262. SleevesD.CopyCoef RubbersD, 0.85
  1263.  
  1264. Class Dampener
  1265. Public Print, debugOn 'tbpOut.text
  1266. public name, Threshold 'Minimum threshold. Useful for Flippers, which don't have a hit threshold.
  1267. Public ModIn, ModOut
  1268. Private Sub Class_Initialize : redim ModIn(0) : redim Modout(0): End Sub
  1269.  
  1270. Public Sub AddPoint(aIdx, aX, aY)
  1271. ShuffleArrays ModIn, ModOut, 1 : ModIn(aIDX) = aX : ModOut(aIDX) = aY : ShuffleArrays ModIn, ModOut, 0
  1272. if gametime > 100 then Report
  1273. End Sub
  1274.  
  1275. public sub Dampen(aBall)
  1276. if threshold then if BallSpeed(aBall) < threshold then exit sub end if end if
  1277. dim RealCOR, DesiredCOR, str, coef
  1278. DesiredCor = LinearEnvelope(cor.ballvel(aBall.id), ModIn, ModOut )
  1279. RealCOR = BallSpeed(aBall) / cor.ballvel(aBall.id)
  1280. coef = desiredcor / realcor
  1281. if debugOn then str = name & " in vel:" & round(cor.ballvel(aBall.id),2 ) & vbnewline & "desired cor: " & round(desiredcor,4) & vbnewline & _
  1282. "actual cor: " & round(realCOR,4) & vbnewline & "ballspeed coef: " & round(coef, 3) & vbnewline
  1283. if Print then debug.print Round(cor.ballvel(aBall.id),2) & ", " & round(desiredcor,3)
  1284.  
  1285. aBall.velx = aBall.velx * coef : aBall.vely = aBall.vely * coef
  1286. if debugOn then TBPout.text = str
  1287. End Sub
  1288.  
  1289. Public Sub CopyCoef(aObj, aCoef) 'alternative addpoints, copy with coef
  1290. dim x : for x = 0 to uBound(aObj.ModIn)
  1291. addpoint x, aObj.ModIn(x), aObj.ModOut(x)*aCoef
  1292. Next
  1293. End Sub
  1294.  
  1295.  
  1296. Public Sub Report() 'debug, reports all coords in tbPL.text
  1297. if not debugOn then exit sub
  1298. dim a1, a2 : a1 = ModIn : a2 = ModOut
  1299. dim str, x : for x = 0 to uBound(a1) : str = str & x & ": " & round(a1(x),4) & ", " & round(a2(x),4) & vbnewline : next
  1300. TBPout.text = str
  1301. End Sub
  1302.  
  1303.  
  1304. End Class
  1305.  
  1306. 'Tracks ball velocity for judging bounce calculations & angle
  1307. 'apologies to JimmyFingers is this is what his script does. I know his tracks ball velocity too but idk how it works in particular
  1308. dim cor : set cor = New CoRTracker
  1309. cor.debugOn = False
  1310. 'cor.update() - put this on a low interval timer
  1311. Class CoRTracker
  1312. public DebugOn 'tbpIn.text
  1313. public ballvel
  1314.  
  1315. Private Sub Class_Initialize : redim ballvel(0) : End Sub
  1316. 'TODO this would be better if it didn't do the sorting every ms, but instead every time it's pulled for COR stuff
  1317. Public Sub Update() 'tracks in-ball-velocity
  1318. dim str, b, AllBalls, highestID : allBalls = getballs
  1319. if uBound(allballs) < 0 then if DebugOn then str = "no balls" : TBPin.text = str : exit Sub else exit sub end if: end if
  1320. for each b in allballs
  1321. if b.id >= HighestID then highestID = b.id
  1322. Next
  1323.  
  1324. if uBound(ballvel) < highestID then redim ballvel(highestID) 'set bounds
  1325.  
  1326. for each b in allballs
  1327. ballvel(b.id) = BallSpeed(b)
  1328. if DebugOn then
  1329. dim s, bs 'debug spacer, ballspeed
  1330. bs = round(BallSpeed(b),1)
  1331. if bs < 10 then s = " " else s = "" end if
  1332. str = str & b.id & ": " & s & bs & vbnewline
  1333. 'str = str & b.id & ": " & s & bs & "z:" & b.z & vbnewline
  1334. end if
  1335. Next
  1336. if DebugOn then str = "ubound ballvels: " & ubound(ballvel) & vbnewline & str : if TBPin.text <> str then TBPin.text = str : end if
  1337. End Sub
  1338. End Class
  1339.  
  1340. Sub RDampen_Timer()
  1341. Cor.Update
  1342. End Sub
  1343.  
  1344.  
  1345.  
  1346. ' Thalamus : Exit in a clean and proper way
  1347. Sub Table1_exit()
  1348. If B2SOn Then
  1349. Controller.Pause = False
  1350. Controller.Stop
  1351. End If
  1352. End Sub
  1353.  
  1354.  
  1355.  
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!