Stripping Funny (Inder 1974)_v0.3

Option Explicit

'   Stripping Funny 1974

'*****************************************************************************************************
' CREDITS
' Initial table created by fuzzel, jimmyfingers, jpsalas, toxie & unclewilly (in alphabetical order)
' Flipper primitives by zany
' Ball rolling sound script by jpsalas
' Ball shadow by ninuzzu
' Ball control & ball dropping sound by rothbauerw
' DOF by arngrim
' Positional sound helper functions by djrobx
' Plus a lot of input from the whole community (sorry if we forgot you :/)
'*****************************************************************************************************

'DOF UpDated by Outhere
'101 Left Flipper
'102 Right Flipper
'103 Left Slingshot
'104 Right Slingshot
'105 Bumper Left
'106 Bumper Center
'107 Bumper Right
'108 Bumper Left Lower
'109 Bumper Right Lower
'110 Ball Release
'111 Kicker_red Right
'112 Kicker_blue Left
'113 Knocker
'114
'115
'116
'117
'118
'119
'120 chime1
'121 chime2
'122 chime3
'123 Bell


'First, try to load the Controller.vbs (DOF), which helps controlling additional hardware like lights, gears, knockers, bells and chimes (to increase realism)
'This table uses DOF via the 'SoundFX' calls that are inserted in some of the PlaySound commands, which will then fire an additional event, instead of just playing a sample/sound effect
On Error Resume Next
ExecuteGlobal GetTextFile("controller.vbs")
If Err Then MsgBox "You need the Controller.vbs file in order to run this table (installed with the VPX package in the scripts folder)"
On Error Goto 0

'If using Visual PinMAME (VPM), place the ROM/game name in the constant below,
'both for VPM, and DOF to load the right DOF config from the Configtool, whether it's a VPM or an Original table

Const cGameName = "stripping_funny"
Const cController = 3


Dim EnableRetractPlunger
EnableRetractPlunger = false 'Change to true to enable retracting the plunger at a linear speed; wait for 1 second at the maximum position; move back towards the resting position; nice for button/key plungers


If Table1.ShowDT = false then
    EMReel.Visible = false
	ShootAgainText.Visible = False
	TextBoxGameOver.Visible = False
	TextBoxRollover.Visible = False
End If

Dim Controller
Dim EnableBallControl
EnableBallControl = false 'Change to true to enable manual ball control (or press C in-game) via the arrow keys and B (boost movement) keys



'#####################################################################################################################################
Const BallSize = 50  'Ball radius
Const BallMass = 1.7
Const maxBalls =3
Dim aa,GameStarted,BIP,PlayerScore,CurrentBall,bonus,Alit,Blit,Clit,Dlit,Elit,Flit,Redlit,TopPoints, BellRing, Chime, Special, SpecialOn, ShootAgain,A5K,B5K,E5K,F5K,lbonus,rbonus

Sub Table1_Init()
	LoadEM
	If Table1.ShowDT = True then
		ShootAgainText.Visible = False
		TextBoxGameOver.visible = True
		TextBoxRollover.Visible = False
	End If
	loadhs
	if HSA1="" then HSA1=25
	if HSA2="" then HSA2=25
	if HSA3="" then HSA3=25
	UpdatePostIt
	For each aa In aBIP
		aa.Opacity = 0
	Next
	If B2SOn Then Controller.B2SSetGameOver 1 'turn off Gameover light
End Sub

Sub StartGame
		if not GameStarted Then
			If Table1.ShowDT = True then
				TextBoxGameOver.Visible = False
				ShootAgainText.Visible = False
				TextBoxRollover.Visible = False
			End If
			If B2SOn Then Controller.B2SStopAnimation "Attract" 'turn off Attract
			If B2SOn Then Controller.B2SSetGameOver 0 'turn off Gameover light
			If B2SOn Then Controller.B2SSetScore 1, PlayerScore
			BIP = 0
			EMReel.setvalue(0)
			GameStarted = True
			'GameEndTimer.enabled = False
			ResetState
			PlayerScore=0
			debug.print "########## Start Game ############"
			NextBall



	end If
End Sub

Sub GameOver
	GameStarted = False
	If B2SOn Then Controller.B2SStartAnimation "Attract" 'turn off Attract
	If B2SOn Then Controller.B2SSetGameOver 1 'turn off Gameover light
	If Table1.ShowDT = True then TextBoxGameOver.Visible = True
	CheckNewHighScorePostIt(PlayerScore)
End Sub

Sub ResetState
	bonus=0
	Special = 0
	SpecialOn = Int(Rnd*6)
	Alit=False
	Blit=False
	Clit=False
	Dlit=False
	Elit=False
	Flit=False
	A5K = False
	B5K = False
	E5K = True
	F5K = True
	lbonus = True
	rbonus = False
	Redlit=False
	ShootAgain = False
	TopPoints=500
	For each aa In aLights
		aa.State = 0
	Next
	For each aa In aLights2
		aa.State = 1
	Next
	For each aa In aLightsSpecial
		aa.State = 0
	Next
	If Table1.ShowDT = True then ShootAgainText.Visible = False
End Sub

Sub NextBall()
	if BIP < maxBalls Then
		If ShootAgain = False Then BIP = BIP + 1 End If
		ResetState
		For each aa In aBIP
			aa.Opacity = 0
		Next
		aBIP(BIP-1).Opacity = 100
		BallRelease.CreateBall
		BallRelease.Kick 90, 7
		PlaySound SoundFXDOF("ballrelease", 110, DOFPulse, DOFContactors), 0,1,AudioPan(BallRelease),0.25,0,0,1,AudioFade(BallRelease)
	Else
		GameOver
	End If
End Sub



Sub Addpoints(ScorePar)
		if GameStarted Then
				Select Case ScorePar
					Case 10 : PlaySound SoundFXDOF("chime1", 120, DOFPulse, DOFChimes)
					Case 100 : PlaySound SoundFXDOF("chime2", 121, DOFPulse, DOFChimes)
					Case 500 : Chime =2: BellRing = 1 : BellTimer.enabled = 1
					Case 1000 : PlaySound SoundFXDOF("chime3", 122, DOFPulse, DOFChimes)
					Case 5000 : Chime =3: BellRing = 1 : BellTimer.enabled = 1
				End Select
				PlayerScore = PlayerScore + ScorePar
				EMReel.setvalue(PlayerScore)
				If B2SOn Then Controller.B2SSetScore 1, PlayerScore
				If PlayerScore >99999 Then
					If Table1.ShowDT = True then TextBoxRollover.Visible = True
					If B2SOn Then Controller.B2SSetScoreRollover 25, 1
				End If
		End If

End Sub

Sub ScoreTimer_timer
	If bonus >0 Then
		Addpoints(1000)
		BonusLadder(bonus-1).State = 0
		bonus = bonus - 1
	Else
		NextBall
		me.Enabled = 0
	End If
End Sub

Sub AddBonus()
	debug.Print bonus
	 If bonus <10 Then
		bonus = bonus + 1
		BonusLadder(bonus-1).state = 1
	End IF
End Sub

Sub BellTimer_Timer
	PlaySound SoundFXDOF("chime", 123, DOFPulse, DOFBell)&Chime
	BellRing = BellRing - 1
	If BellRing < 1 Then
		SpecialSet
		BellTimer.enabled = 0
	End If
End Sub

Sub SpecialSet
	'Special = 6
	If Special = 6 Then
		If SpecialOn <5 Then
			aLightsSpecial(SpecialOn).State = 0
			SpecialOn = SpecialOn +1
			aLightsSpecial(SpecialOn).State = 2
		Else
			aLightsSpecial(5).State = 0
			SpecialOn = 0
			aLightsSpecial(SpecialOn).State = 2
		End If
	End If
	DEBUG.PRINT "special" & Special & "  specialon" & SpecialOn
End Sub

Sub SpecialHit
	ShootAgain = True
	If B2SOn Then Controller.B2SSetShootAgain 1
	If Table1.ShowDT = True then ShootAgainText.Visible = True
	Special = 0
	PlaySound SoundFXDOF("Knocker", 113, DOFPulse, DOFKnocker)
	aLightsSpecial(SpecialOn).State = 0
	debug.print "###################EXTRA BALL################"
End Sub

Sub Toggle_Bonus
	If lbonus = True Then
		Light_LBonus.State = 0
		Light_RBonus.State = 1
		lbonus = False
		rbonus = True
	Else
		Light_LBonus.State = 1
		Light_RBonus.State = 0
		lbonus = True
		rbonus = False
	End If
End Sub
'#########################################################################
'### Scoring

Sub Trigger_A_Hit
	PlaySound "fx_sensor",0,1,AudioPan(Trigger_A),0.25,0,0,1,AudioFade(Trigger_A)
	If Alit =False Then
		Alit =True
		Special = Special +1
		Light_A.State = 1
		Light_A1.State = 1
		Light_A2.State = 1
		Light_A3.State = 0
		Light_A4.State = 0
		Light_A5K.State = 1
		A5K = True
		E5K = False
		F5K = False
		Light_E5k.state = 0
		Light_F5k.state = 0
		If Blit = True Then
			TopPoints = 5000
		End If
	Else
		AddBonus
	End If
	Addpoints(TopPoints)
End Sub

Sub Trigger_B_Hit
	PlaySound "fx_sensor",0,1,AudioPan(Trigger_B),0.25,0,0,1,AudioFade(Trigger_B)
	If Blit =False Then
		Blit =True
		Special = Special +1
		Light_B.State = 1
		Light_B1.State = 1
		Light_B2.State = 1
		Light_B3.State = 0
		Light_B4.State = 0
		Light_B5K.State = 1
		B5K = True
		E5K = False
		F5K = False
		Light_E5k.state = 0
		Light_F5k.state = 0
		If Alit = True Then
			TopPoints = 5000
		End If
	Else
		AddBonus
	End If
	Addpoints(TopPoints)
End Sub

Sub Trigger_C_Hit
	PlaySound "fx_sensor",0,1,AudioPan(Trigger_C),0.25,0,0,1,AudioFade(Trigger_C)
	If Clit =False Then
		Clit =True
		Special = Special +1
		Light_C.State = 1
		Light_C1.State = 1
		Light_C3.State = 0
		E5K = False
		F5K = False
		Light_E5k.state = 0
		Light_F5k.state = 0
	Else
		AddBonus
	End If
	Addpoints(500)
End Sub

Sub Trigger_D_Hit
	PlaySound "fx_sensor",0,1,AudioPan(Trigger_D),0.25,0,0,1,AudioFade(Trigger_D)
	If Dlit =False Then
		Dlit =True
		Special = Special +1
		Light_D.State = 1
		Light_D1.State = 1
		Light_D3.State = 0
		E5K = False
		F5K = False
		Light_E5k.state = 0
		Light_F5k.state = 0
	Else
		AddBonus
	End If
	If Special = 6 and SpecialOn = 3 Then SpecialHit
	Addpoints(500)
End Sub

Sub Trigger_red_on_Hit
	If Redlit =False Then
		Redlit =True
		Light_Red.State = 1
		Light_red_on.state = 1
		Light_red_off.state = 0
	End If
End Sub

Sub Trigger_red_off_Hit
	If Redlit =True Then
		Redlit =False
		Light_Red.State = 0
		Light_red_on.state = 0
		Light_red_off.state = 1
	End If
End Sub

Sub Target_E_Hit
	PlaySound "target",0,1,AudioPan(Target_E),0.25,0,0,1,AudioFade(Target_E)
	If Elit =False Then
		Elit =True
		Special = Special +1
		Light_E1.State = 1
		Light_E3.State = 0
	Else
		AddBonus
	End If
	If Special = 6 and SpecialOn = 5 Then SpecialHit
	If E5K = True Then Addpoints(5000) Else Addpoints(500)
End Sub

Sub Target_F_Hit
	PlaySound "target",0,1,AudioPan(Target_F),0.25,0,0,1,AudioFade(Target_F)
	If Flit =False Then
		Flit =True
		Special = Special +1
		Light_F1.State = 1
		Light_F3.State = 0
	Else
		AddBonus
	End If
	If Special = 6 and SpecialOn = 2 Then SpecialHit
	If F5K = True Then Addpoints(5000) Else Addpoints(500)
End Sub

Sub LeftInlane_Hit
	PlaySound "fx_sensor",0,1,AudioPan(LeftInlane),0.25,0,0,1,AudioFade(LeftInlane)
	If B5K = True Then Addpoints(5000)
End Sub

Sub RightInlane_Hit
	PlaySound "fx_sensor",0,1,AudioPan(RightInlane),0.25,0,0,1,AudioFade(RightInlane)
	If A5K = True Then Addpoints(5000)
End Sub

Sub LeftOutlane_Hit
	PlaySound "fx_sensor",0,1,AudioPan(LeftOutlane),0.25,0,0,1,AudioFade(LeftOutlane)
		If Special = 6 and SpecialOn = 4 Then SpecialHit
	If lbonus = True Then AddBonus
End Sub

Sub RightOutlane_Hit
	PlaySound "fx_sensor",0,1,AudioPan(RightOutlane),0.25,0,0,1,AudioFade(RightOutlane)
	If Special = 6 and SpecialOn = 3 Then SpecialHit
	If rbonus = True Then AddBonus
End Sub

Sub Bumper_A_Hit
	PlaySound SoundFXDOF("fx_bumper4", 105, DOFPulse, DOFContactors), 0,1,AudioPan(Bumper_A),0,0,0,1,AudioFade(Bumper_A)
	If Alit =True Then
	Addpoints(100)
	Else Addpoints(10) End If
End Sub

Sub Bumper_B_Hit
	PlaySound SoundFXDOF("fx_bumper4", 107, DOFPulse, DOFContactors), 0,1,AudioPan(Bumper_B),0,0,0,1,AudioFade(Bumper_B)
	If Blit =True Then
	Addpoints(100)
	Else Addpoints(10) End If
End Sub

Sub Bumper_C_Hit
	PlaySound SoundFXDOF("fx_bumper4", 108, DOFPulse, DOFContactors), 0,1,AudioPan(Bumper_C),0,0,0,1,AudioFade(Bumper_C)
	If Clit =True Then
	Addpoints(100)
	Else Addpoints(10) End If
End Sub


Sub Bumper_D_Hit
	PlaySound SoundFXDOF("fx_bumper4", 109, DOFPulse, DOFContactors), 0,1,AudioPan(Bumper_D),0,0,0,1,AudioFade(Bumper_D)
	If Dlit =True Then
	Addpoints(100)
	Else Addpoints(10) End If
End Sub

Sub Bumper_Red_Hit
	PlaySound SoundFXDOF("fx_bumper4", 106, DOFPulse, DOFContactors), 0,1,AudioPan(Bumper_Red),0,0,0,1,AudioFade(Bumper_Red)
	If Redlit =True Then Addpoints(1000) Else Addpoints(10) End If
End Sub

Sub Target_adv_bonus_Hit
	AddBonus
End Sub

Sub Kicker_red_Hit
	me.timerenabled = True
End Sub

Sub Kicker_red_Timer
	me.Kick 200, 7
	PlaySound SoundFXDOF("popper_ball", 111, DOFPulse, DOFContactors), 0,1,AudioPan(Kicker_red),0,0,0,1,AudioFade(Kicker_red)
	If Special = 6 and SpecialOn = 1 Then SpecialHit
	Addpoints(500)
	me.timerenabled = False
End Sub

Sub Kicker_blue_Hit
	me.timerenabled = True
End Sub

Sub Kicker_blue_Timer
	me.Kick 160, 7
	PlaySound SoundFXDOF("popper_ball", 112, DOFPulse, DOFContactors), 0,1,AudioPan(Kicker_blue),0,0,0,1,AudioFade(Kicker_blue)
	If Special = 6 and SpecialOn = 0 Then SpecialHit
	Addpoints(500)
	me.timerenabled = False
End Sub

'##########################################################################################################
dim rms,lms
Sub Table1_KeyDown(ByVal keycode)
	If keycode = PlungerKey Then Plunger.Pullback:playsound"plungerpull"

	If Keycode = StartGameKey And Not HSEnterMode=true And not rms = true Then
		StartGame
	Elseif keycode = StartGameKey And Not HSEnterMode=true And rms = true Then
		deletehs
	End If
	If keycode = LeftMagnaSave Then lms = True
	If keycode = RightMagnaSave And lms = True Then rms = True

	If HSEnterMode Then
		HighScoreProcessKey(keycode)
	End If

	If keycode = LeftFlipperKey Then
        LeftFlipper.TimerEnabled = True 'This line is only for ninuzzu's flipper shadows!
		LeftFlipper.RotateToEnd
		PlaySound SoundFXDOF("fx_flipperup", 101, DOFOn, DOFFlippers), 0, .67, AudioPan(LeftFlipper), 0.05,0,0,1,AudioFade(LeftFlipper)
	End If

	If keycode = RightFlipperKey Then
        RightFlipper.TimerEnabled = True 'This line is only for ninuzzu's flipper shadows!
		RightFlipper.RotateToEnd
		PlaySound SoundFXDOF("fx_flipperup", 102, DOFOn, DOFFlippers), 0, .67, AudioPan(RightFlipper), 0.05,0,0,1,AudioFade(RightFlipper)
	End If

	If keycode = LeftTiltKey Then
		Nudge 90, 2
	End If

	If keycode = RightTiltKey Then
		Nudge 270, 2
	End If

	If keycode = CenterTiltKey Then
		Nudge 0, 2
	End If

    ' Manual Ball Control
	If keycode = 46 Then	 				' C Key
		If EnableBallControl = 1 Then
			EnableBallControl = 0
		Else
			EnableBallControl = 1
		End If
	End If
    If EnableBallControl = 1 Then
		If keycode = 48 Then 				' B Key
			If BCboost = 1 Then
				BCboost = BCboostmulti
			Else
				BCboost = 1
			End If
		End If
		If keycode = 203 Then BCleft = 1	' Left Arrow
		If keycode = 200 Then BCup = 1		' Up Arrow
		If keycode = 208 Then BCdown = 1	' Down Arrow
		If keycode = 205 Then BCright = 1	' Right Arrow
	End If
End Sub

Sub Table1_KeyUp(ByVal keycode)
	If keycode = PlungerKey Then Plunger.Fire:PlaySound"plunger"
	If keycode = RightMagnaSave Then rms = False
	If keycode = LeftMagnaSave Then lms = False

	If keycode = LeftFlipperKey Then
		LeftFlipper.RotateToStart
		PlaySound SoundFXDOF("fx_flipperdown", 101, DOFOff, DOFFlippers), 0, 1, AudioPan(LeftFlipper), 0.05,0,0,1,AudioFade(LeftFlipper)
	End If

	If keycode = RightFlipperKey Then
		RightFlipper.RotateToStart
		PlaySound SoundFXDOF("fx_flipperdown", 102, DOFOff, DOFFlippers), 0, 1, AudioPan(RightFlipper), 0.05,0,0,1,AudioFade(RightFlipper)
	End If

    'Manual Ball Control
	If EnableBallControl = 1 Then
		If keycode = 203 Then BCleft = 0	' Left Arrow
		If keycode = 200 Then BCup = 0		' Up Arrow
		If keycode = 208 Then BCdown = 0	' Down Arrow
		If keycode = 205 Then BCright = 0	' Right Arrow
	End If
End Sub


Sub Drain_Hit()
	PlaySound "drain",0,1,AudioPan(Drain),0.25,0,0,1,AudioFade(Drain)
	Drain.DestroyBall
	ScoreTimer.Enabled = 1
End Sub





'*****GI Lights On
dim xx

For each xx in GI:xx.State = 1: Next

'**********Sling Shot Animations
' Rstep and Lstep  are the variables that increment the animation
'****************
Dim RStep, Lstep

Sub RightSlingShot_Slingshot
    PlaySound SoundFXDOF("right_slingshot", 104, DOFPulse, DOFContactors), 0,1, 0.05,0.05 '0,1, AudioPan(RightSlingShot), 0.05,0,0,1,AudioFade(RightSlingShot)
    RSling.Visible = 0
    RSling1.Visible = 1
    sling1.rotx = 20
    RStep = 0
    RightSlingShot.TimerEnabled = 1
	Toggle_Bonus
End Sub

Sub RightSlingShot_Timer
    Select Case RStep
        Case 3:RSLing1.Visible = 0:RSLing2.Visible = 1:sling1.rotx = 10
        Case 4:RSLing2.Visible = 0:RSLing.Visible = 1:sling1.rotx = 0:RightSlingShot.TimerEnabled = 0
    End Select
    RStep = RStep + 1
End Sub

Sub LeftSlingShot_Slingshot
    PlaySound SoundFXDOF("left_slingshot", 103, DOFPulse, DOFContactors), 0,1, -0.05,0.05 '0,1, AudioPan(LeftSlingShot), 0.05,0,0,1,AudioFade(LeftSlingShot)
    LSling.Visible = 0
    LSling1.Visible = 1
    sling2.rotx = 20
    LStep = 0
    LeftSlingShot.TimerEnabled = 1
	Toggle_Bonus
End Sub

Sub LeftSlingShot_Timer
    Select Case LStep
        Case 3:LSLing1.Visible = 0:LSLing2.Visible = 1:sling2.rotx = 10
        Case 4:LSLing2.Visible = 0:LSLing.Visible = 1:sling2.rotx = 0:LeftSlingShot.TimerEnabled = 0
    End Select
    LStep = LStep + 1
End Sub


'*********************************************************************
'                 Positional Sound Playback Functions
'*********************************************************************

' Play a sound, depending on the X,Y position of the table element (especially cool for surround speaker setups, otherwise stereo panning only)
' parameters (defaults): loopcount (1), volume (1), randompitch (0), pitch (0), useexisting (0), restart (1))
' Note that this will not work (currently) for walls/slingshots as these do not feature a simple, single X,Y position
Sub PlayXYSound(soundname, tableobj, loopcount, volume, randompitch, pitch, useexisting, restart)
	PlaySound soundname, loopcount, volume, AudioPan(tableobj), randompitch, pitch, useexisting, restart, AudioFade(tableobj)
End Sub

' Similar subroutines that are less complicated to use (e.g. simply use standard parameters for the PlaySound call)
Sub PlaySoundAt(soundname, tableobj)
    PlaySound soundname, 1, 1, AudioPan(tableobj), 0,0,0, 1, AudioFade(tableobj)
End Sub

Sub PlaySoundAtBall(soundname)
    PlaySoundAt soundname, ActiveBall
End Sub


'*********************************************************************
'                     Supporting Ball & Sound Functions
'*********************************************************************
Dim TableWidth, TableHeight

TableWidth = Table1.width
TableHeight = Table1.height



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
	Dim tmp
    tmp = tableobj.y * 2 / TableHeight-1
    If tmp > 0 Then
		AudioFade = Csng(tmp ^10)
    Else
        AudioFade = Csng(-((- tmp) ^10) )
    End If
End Function

Function AudioPan(tableobj) ' Calculates the pan for a tableobj based on the X position on the table. "table1" is the name of the table
    Dim tmp
    tmp = tableobj.x * 2 / TableWidth-1
    If tmp > 0 Then
        AudioPan = Csng(tmp ^10)
    Else
        AudioPan = Csng(-((- tmp) ^10) )
    End If
End Function

Function Vol(ball) ' Calculates the Volume of the sound based on the ball speed
    Vol = Csng(BallVel(ball) ^2 / 2000)
End Function

Function Pitch(ball) ' Calculates the pitch of the sound based on the ball speed
    Pitch = BallVel(ball) * 20
End Function

Function BallVel(ball) 'Calculates the ball speed
    BallVel = INT(SQR((ball.VelX ^2) + (ball.VelY ^2) ) )
End Function


'*****************************************
'   rothbauerw's Manual Ball Control
'*****************************************

Dim BCup, BCdown, BCleft, BCright
Dim ControlBallInPlay, ControlActiveBall
Dim BCvel, BCyveloffset, BCboostmulti, BCboost

BCboost = 1				'Do Not Change - default setting
BCvel = 4				'Controls the speed of the ball movement
BCyveloffset = -0.01 	'Offsets the force of gravity to keep the ball from drifting vertically on the table, should be negative
BCboostmulti = 3		'Boost multiplier to ball veloctiy (toggled with the B key)

ControlBallInPlay = false

Sub StartBallControl_Hit()
	Set ControlActiveBall = ActiveBall
	ControlBallInPlay = true
End Sub

Sub StopBallControl_Hit()
	ControlBallInPlay = false
End Sub

Sub BallControlTimer_Timer()
	If EnableBallControl and ControlBallInPlay then
		If BCright = 1 Then
			ControlActiveBall.velx =  BCvel*BCboost
		ElseIf BCleft = 1 Then
			ControlActiveBall.velx = -BCvel*BCboost
		Else
			ControlActiveBall.velx = 0
		End If

		If BCup = 1 Then
			ControlActiveBall.vely = -BCvel*BCboost
		ElseIf BCdown = 1 Then
			ControlActiveBall.vely =  BCvel*BCboost
		Else
			ControlActiveBall.vely = bcyveloffset
		End If
	End If
End Sub


'********************************************************************
'      JP's VP10 Rolling Sounds (+rothbauerw's Dropping Sounds)
'********************************************************************

Const tnob = 4 ' total number of balls
ReDim rolling(tnob)
Dim shadowm,shadowc
shadowc=Ballsize*0.75 'distance of shadow from ball at the furthest point
shadowm= ((TableWidth/2)+shadowc)/(TableWidth/2) 'slope of the linear change around the centerpoint of the table
InitRolling

Sub InitRolling
    Dim i
    For i = 0 to tnob
        rolling(i) = False
    Next
End Sub

Sub RollingTimer_Timer()
    Dim BOT, b,speedfactorx,speedfactory
	Const maxvel = 30 'max ball velocity
   BOT = GetBalls

    ' stop the sound of deleted balls
    For b = UBound(BOT) + 1 to tnob
        rolling(b) = False
        StopSound("fx_ballrolling" & b)
		aBallShadow(b).visible = 0
    Next

    ' exit the sub if no balls on the table
    If UBound(BOT) = -1 Then Exit Sub

    For b = 0 to UBound(BOT)
        aBallShadow(b).X = shadowm*BOT(b).X - shadowc'y=mx+c
		aBallShadow(b).Y = BOT(b).Y + 12
        If BOT(b).Z > 20 Then
            aBallShadow(b).visible = 1
			'debug.Print aBallShadow(b).X
        Else
            aBallShadow(b).visible = 0
        End If
		If BOT(b).VelX AND BOT(b).VelY <> 0 Then
			speedfactorx = ABS(maxvel / BOT(b).VelX)
			speedfactory = ABS(maxvel / BOT(b).VelY)
			If speedfactorx <1 Then
				BOT(b).VelX = BOT(b).VelX * speedfactorx
				BOT(b).VelY = BOT(b).VelY * speedfactorx
			End If
			If speedfactory <1 Then
				BOT(b).VelX = BOT(b).VelX * speedfactory
				BOT(b).VelY = BOT(b).VelY * speedfactory
			End If
		End If
        ' play the rolling sound for each ball
        If BallVel(BOT(b) ) > 1 AND BOT(b).z < 30 Then
            rolling(b) = True
            PlaySound("fx_ballrolling" & b), -1, Vol(BOT(b)), AudioPan(BOT(b)), 0, Pitch(BOT(b)), 1, 0, AudioFade(BOT(b))
        Else
            If rolling(b) = True Then
                StopSound("fx_ballrolling" & b)
                rolling(b) = False
            End If
        End If

        ' play ball drop sounds
        If BOT(b).VelZ < -1 and BOT(b).z < 55 and BOT(b).z > 27 Then 'height adjust for ball drop sounds
            PlaySound "fx_ball_drop" & b, 0, ABS(BOT(b).velz)/17, AudioPan(BOT(b)), 0, Pitch(BOT(b)), 1, 0, AudioFade(BOT(b))
        End If
    Next
End Sub


'**********************
' Ball Collision Sound
'**********************

Sub OnBallBallCollision(ball1, ball2, velocity)
	PlaySound("fx_collide"), 0, Csng(velocity) ^2 / 2000, AudioPan(ball1), 0, Pitch(ball1), 0, 0, AudioFade(ball1)
End Sub


'*****************************************
'	ninuzzu's	FLIPPER SHADOWS v2
'*****************************************

'Add TimerEnabled=True to Table1_KeyDown procedure
' Example :
'Sub Table1_KeyDown(ByVal keycode)
'    If keycode = LeftFlipperKey Then
'        LeftFlipper.TimerEnabled = True 'Add this
'        LeftFlipper.RotateToEnd
'    End If
'    If keycode = RightFlipperKey Then
'        RightFlipper.TimerEnabled = True 'And add this
'        RightFlipper.RotateToEnd
'    End If
'End Sub

Sub LeftFlipper_Init()
    LeftFlipper.TimerInterval = 10
End Sub

Sub RightFlipper_Init()
    RightFlipper.TimerInterval = 10
End Sub

Sub LeftFlipper_Timer()
    FlipperLSh.RotZ = LeftFlipper.CurrentAngle
    If LeftFlipper.CurrentAngle = LeftFlipper.StartAngle Then
        LeftFlipper.TimerEnabled = False
    End If
End Sub

Sub RightFlipper_Timer()
    FlipperRSh.RotZ = RightFlipper.CurrentAngle
    If RightFlipper.CurrentAngle = RightFlipper.StartAngle Then
        RightFlipper.TimerEnabled = False
    End If
End Sub



'************************************
' What you need to add to your table
'************************************

' a timer called RollingTimer. With a fast interval, like 10
' one collision sound, in this script is called fx_collide
' as many sound files as max number of balls, with names ending with 0, 1, 2, 3, etc
' for ex. as used in this script: fx_ballrolling0, fx_ballrolling1, fx_ballrolling2, fx_ballrolling3, etc


'******************************************
' Explanation of the rolling sound routine
'******************************************

' sounds are played based on the ball speed and position

' the routine checks first for deleted balls and stops the rolling sound.

' The For loop goes through all the balls on the table and checks for the ball speed and
' if the ball is on the table (height lower than 30) then then it plays the sound
' otherwise the sound is stopped, like when the ball has stopped or is on a ramp or flying.

' The sound is played using the VOL, AUDIOPAN, AUDIOFADE and PITCH functions, so the volume and pitch of the sound
' will change according to the ball speed, and the AUDIOPAN & AUDIOFADE functions will change the stereo position
' according to the position of the ball on the table.


'**************************************
' Explanation of the collision routine
'**************************************

' The collision is built in VP.
' You only need to add a Sub OnBallBallCollision(ball1, ball2, velocity) and when two balls collide they
' 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
' depending of the speed of the collision.


Sub Pins_Hit (idx)
	PlaySound "pinhit_low", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall)
End Sub

Sub Targets_Hit (idx)
	PlaySound "target", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 0, 0, AudioFade(ActiveBall)
End Sub

Sub Metals_Thin_Hit (idx)
	PlaySound "metalhit_thin", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
End Sub

Sub Metals_Medium_Hit (idx)
	PlaySound "metalhit_medium", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
End Sub

Sub Metals2_Hit (idx)
	PlaySound "metalhit2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
End Sub

Sub Gates_Hit (idx)
	PlaySound "gate4", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
End Sub

Sub Spinner_Spin
	PlaySound "fx_spinner", 0, .25, AudioPan(Spinner), 0.25, 0, 0, 1, AudioFade(Spinner)
End Sub

Sub Rubbers_Hit(idx)
 	dim finalspeed
  	finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
 	If finalspeed > 20 then
		PlaySound "fx_rubber2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
	End if
	If finalspeed >= 6 AND finalspeed <= 20 then
 		RandomSoundRubber()
 	End If
End Sub

Sub Posts_Hit(idx)
 	dim finalspeed
  	finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
 	If finalspeed > 16 then
		PlaySound "fx_rubber2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
	End if
	If finalspeed >= 6 AND finalspeed <= 16 then
 		RandomSoundRubber()
 	End If
End Sub

Sub RandomSoundRubber()
	Select Case Int(Rnd*3)+1
		Case 1 : PlaySound "rubber_hit_1", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
		Case 2 : PlaySound "rubber_hit_2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
		Case 3 : PlaySound "rubber_hit_3", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
	End Select
End Sub

Sub LeftFlipper_Collide(parm)
 	RandomSoundFlipper()
End Sub

Sub RightFlipper_Collide(parm)
 	RandomSoundFlipper()
End Sub

Sub RandomSoundFlipper()
	Select Case Int(Rnd*3)+1
		Case 1 : PlaySound "flip_hit_1", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
		Case 2 : PlaySound "flip_hit_2", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
		Case 3 : PlaySound "flip_hit_3", 0, Vol(ActiveBall), AudioPan(ActiveBall), 0, Pitch(ActiveBall), 1, 0, AudioFade(ActiveBall)
	End Select
End Sub


'==========================================================================================================================================
'============================================================= START OF HIGH SCORES ROUTINES =============================================================
'==========================================================================================================================================
'
'ADD LINE TO TABLE_KEYDOWN SUB WITH THE FOLLOWING:    If HSEnterMode Then HighScoreProcessKey(keycode) AFTER THE STARTGAME ENTRY
'ADD: And Not HSEnterMode=true TO IF KEYCODE=STARTGAMEKEY
'TO SHOW THE SCORE ON POST-IT ADD LINE AT RELEVENT LOCATION THAT HAS:  UpdatePostIt
'TO INITIATE ADDING INITIALS ADD LINE AT RELEVENT LOCATION THAT HAS:  HighScoreEntryInit()
'ADD THE FOLLOWING LINES TO TABLE_INIT TO SETUP POSTIT
'	if HSA1="" then HSA1=25
'	if HSA2="" then HSA2=25
'	if HSA3="" then HSA3=25
'	UpdatePostIt
'ADD HSA1, HSA2 AND HSA3 TO SAVE AND LOAD VALUES FOR TABLE
'ADD A TIMER NAMED HighScoreFlashTimer WITH INTERVAL 100 TO TABLE
'SET HSSSCOREX BELOW TO WHATEVER VARIABLE YOU USE FOR HIGH SCORE.
'ADD OBJECTS TO PLAYFIELD (EASIEST TO JUST COPY FROM THIS TABLE)
'IMPORT POST-IT IMAGES


Sub CheckNewHighScorePostIt(newScore)
		If CLng(newScore) > CLng(HSAHighScore) Then
			HSAHighScore=newScore
			HighScoreEntryInit()
		Else
		End If
End Sub


Dim HSA1, HSA2, HSA3,HSAHighScore
Dim HSEnterMode, hsLetterFlash, hsEnteredDigits(3), hsCurrentDigit, hsCurrentLetter
Dim HSArray
Dim HSScoreM,HSScore100k, HSScore10k, HSScoreK, HSScore100, HSScore10, HSScore1, HSScorex	'Define 6 different score values for each reel to use
HSArray = Array("Postit0","postit1","postit2","postit3","postit4","postit5","postit6","postit7","postit8","postit9","postitBL","postitCM","Tape")
Const hsFlashDelay = 4
Const HighScoreFilename = "StrippingFunny.txt"
Dim FileObj,ScoreFile
sub savehs
	Set FileObj=CreateObject("Scripting.FileSystemObject")
	If Not FileObj.FolderExists(UserDirectory) then
		Exit Sub
	End if
	Set ScoreFile=FileObj.CreateTextFile(UserDirectory & HighScoreFilename,True)
		ScoreFile.WriteLine HSAHighScore
		ScoreFile.WriteLine HSA1
		ScoreFile.WriteLine HSA2
		ScoreFile.WriteLine HSA3
		ScoreFile.Close
	Set ScoreFile=Nothing
	Set FileObj=Nothing
end sub

sub loadhs
	Dim FileObj
	Dim ScoreFile
	Dim TextStr
    Dim SavedDataTempScore, SavedDataTempHSA1, SavedDataTempHSA2, SavedDataTempHSA3 'HighScore
    Set FileObj=CreateObject("Scripting.FileSystemObject")
	If Not FileObj.FolderExists(UserDirectory) then
		Exit Sub
	End if
	If Not FileObj.FileExists(UserDirectory & HighScoreFilename) then
		SetDefaultHSTD:UpdatePostIt:savehs
		Exit Sub
	End if
	Set ScoreFile=FileObj.GetFile(UserDirectory & HighScoreFilename)
	Set TextStr=ScoreFile.OpenAsTextStream(1,0)
		If (TextStr.AtEndOfStream=True) then
			SetDefaultHSTD:UpdatePostIt:savehs
			Exit Sub
		End if
		SavedDataTempScore=Textstr.ReadLine ' HighScore
		HSA1=Textstr.ReadLine ' HighScore
		HSA2=Textstr.ReadLine ' HighScore
		HSA3=Textstr.ReadLine ' HighScore
		TextStr.Close
		HSAHighScore=SavedDataTempScore
		UpdatePostIt
	    Set ScoreFile = Nothing
	    Set FileObj = Nothing
end sub

sub deletehs
	debug.print "delete HS file"
	Set FileObj=CreateObject("Scripting.FileSystemObject")
	If FileObj.FileExists(UserDirectory & HighScoreFilename) then
		SetDefaultHSTD:UpdatePostIt:savehs
		Exit Sub
	End if

end Sub
Sub SetDefaultHSTD  'bad data or missing file - reset and resave
	HSAHighScore = 10000
	HSA1 = 1
	HSA2 = 1
	HSA3 = 1
End Sub


' ***********************************************************
'  HiScore DISPLAY
' ***********************************************************

Sub UpdatePostIt
	dim tempscore
	HSScorex = HSAHighScore
	TempScore = HSScorex
	HSScore1 = 0
	HSScore10 = 0
	HSScore100 = 0
	HSScoreK = 0
	HSScore10k = 0
	HSScore100k = 0
	HSScoreM = 0
	if len(TempScore) > 0 Then
		HSScore1 = cint(right(Tempscore,1))
	end If
	if len(TempScore) > 1 Then
		TempScore = Left(TempScore,len(TempScore)-1)
		HSScore10 = cint(right(Tempscore,1))
	end If
	if len(TempScore) > 1 Then
		TempScore = Left(TempScore,len(TempScore)-1)
		HSScore100 = cint(right(Tempscore,1))
	end If
	if len(TempScore) > 1 Then
		TempScore = Left(TempScore,len(TempScore)-1)
		HSScoreK = cint(right(Tempscore,1))
	end If
	if len(TempScore) > 1 Then
		TempScore = Left(TempScore,len(TempScore)-1)
		HSScore10k = cint(right(Tempscore,1))
	end If
	if len(TempScore) > 1 Then
		TempScore = Left(TempScore,len(TempScore)-1)
		HSScore100k = cint(right(Tempscore,1))
	end If
	if len(TempScore) > 1 Then
		TempScore = Left(TempScore,len(TempScore)-1)
		HSScoreM = cint(right(Tempscore,1))
	end If
	PScore5.image = HSArray(HSScore100K):If HSScorex<100000 Then PScore5.image = HSArray(10)
	PScore4.image = HSArray(HSScore10K):If HSScorex<10000 Then PScore4.image = HSArray(10)
	PScore3.image = HSArray(HSScoreK):If HSScorex<1000 Then PScore3.image = HSArray(10)
	PScore2.image = HSArray(HSScore100):If HSScorex<100 Then PScore2.image = HSArray(10)
	PScore1.image = HSArray(HSScore10):If HSScorex<10 Then PScore1.image = HSArray(10)
	PScore0.image = HSArray(HSScore1):If HSScorex<1 Then PScore0.image = HSArray(10)

'	if showhisc=1 and showhiscnames=1 then
'		for each objekt in hiscname:objekt.visible=1:next
		HSName1.image = ImgFromCode(HSA1, 1)
		HSName2.image = ImgFromCode(HSA2, 2)
		HSName3.image = ImgFromCode(HSA3, 3)
'	  else
'		for each objekt in hiscname:objekt.visible=0:next
'	end if
End Sub

Function ImgFromCode(code, digit)
	Dim Image
	if (HighScoreFlashTimer.Enabled = True and hsLetterFlash = 1 and digit = hsCurrentLetter) then
		Image = "postitBL"
	elseif (code + ASC("A") - 1) >= ASC("A") and (code + ASC("A") - 1) <= ASC("Z") then
		Image = "postit" & chr(code + ASC("A") - 1)
	elseif code = 27 Then
		Image = "PostitLT"
    elseif code = 0 Then
		image = "PostitSP"
    Else
      msgbox("Unknown display code: " & code)
	end if
	ImgFromCode = Image
End Function

Sub HighScoreEntryInit()
	PlaySound SoundFXDOF("Knocker", 113, DOFPulse, DOFKnocker)
	HSA1=0:HSA2=0:HSA3=0
	HSEnterMode = True
	hsCurrentDigit = 0
	hsCurrentLetter = 1:HSA1=1
	HighScoreFlashTimer.Interval = 250
	HighScoreFlashTimer.Enabled = True
	hsLetterFlash = hsFlashDelay
End Sub

Sub HighScoreFlashTimer_Timer()
	hsLetterFlash = hsLetterFlash-1
	UpdatePostIt
	If hsLetterFlash=0 then 'switch back
		hsLetterFlash = hsFlashDelay
	end if
End Sub


' ***********************************************************
'  HiScore ENTER INITIALS
' ***********************************************************

Sub HighScoreProcessKey(keycode)
    If keycode = LeftFlipperKey Then
		hsLetterFlash = hsFlashDelay
		Select Case hsCurrentLetter
			Case 1:
				HSA1=HSA1-1:If HSA1=-1 Then HSA1=26 'no backspace on 1st digit
				UpdatePostIt
			Case 2:
				HSA2=HSA2-1:If HSA2=-1 Then HSA2=27
				UpdatePostIt
			Case 3:
				HSA3=HSA3-1:If HSA3=-1 Then HSA3=27
				UpdatePostIt
		 End Select
    End If

	If keycode = RightFlipperKey Then
		hsLetterFlash = hsFlashDelay
		Select Case hsCurrentLetter
			Case 1:
				HSA1=HSA1+1:If HSA1>26 Then HSA1=0
				UpdatePostIt
			Case 2:
				HSA2=HSA2+1:If HSA2>27 Then HSA2=0
				UpdatePostIt
			Case 3:
				HSA3=HSA3+1:If HSA3>27 Then HSA3=0
				UpdatePostIt
		 End Select
	End If

    If (keycode = StartGameKey or keycode = PlungerKey) Then
		Select Case hsCurrentLetter
			Case 1:
				hsCurrentLetter=2 'ok to advance
				HSA2=HSA1 'start at same alphabet spot
'				EMReelHSName1.SetValue HSA1:EMReelHSName2.SetValue HSA2
			Case 2:
				If HSA2=27 Then 'bksp
					HSA2=0
					hsCurrentLetter=1
				Else
					hsCurrentLetter=3 'enter it
					HSA3=HSA2 'start at same alphabet spot
				End If
			Case 3:
				If HSA3=27 Then 'bksp
					HSA3=0
					hsCurrentLetter=2
				Else
					savehs 'enter it
					HighScoreFlashTimer.Enabled = False
					HSEnterMode = False
					If B2SOn Then Controller.B2SStartAnimation "Attract" 'turn on Attract
				End If
		End Select
		UpdatePostIt
    End If
End Sub