Argosy (Williams 1977) 1.3

Option Explicit

'*****************************************************************************************************
' 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
'105 right slingshot
'106
'107 left bumper
'108
'109 RIGHT Bumper
'110 ballrelease
'118 Kicker
'121 knocker
'204 Reset drop Targets
'214 upper left singshot



'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

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 = 25  'Ball radius

Const cGameName = "Argosy_1977"

Dim Desktop : Desktop = Table1.ShowDT



Dim ScoreObj
For Each ScoreObj in BackglassObjs
	If Desktop=True Then
		ScoreObj.visible = True
	Else
		ScoreObj.visible = False
	End If
Next

Sub Table1_KeyDown(ByVal keycode)

    If Inprogress=True And Tilted=False Then
		If keycode = LeftFlipperKey Then
			LeftFlipper.RotateToEnd
			PlaySound SoundFXDOF("fx_flipperup", 101, DOFOn, DOFFlippers), 0, .67, AudioPan(LeftFlipper), 0.05,0,0,1,AudioFade(LeftFlipper)
			PlaySound "buzz_left", -1, 1.0, AudioPan(LeftFlipper)
		End If

		If keycode = RightFlipperKey Then
			RightFlipper.RotateToEnd
			PlaySound SoundFXDOF("fx_flipperup", 102, DOFOn, DOFFlippers), 0, .67, AudioPan(RightFlipper), 0.05,0,0,1,AudioFade(RightFlipper)
			PlaySound "buzz_right", -1, 1.0, AudioPan(RightFlipper)
		End If

		If keycode = LeftTiltKey Then
			Nudge 90, 2
			CheckTilt
		End If

		If keycode = RightTiltKey Then
			Nudge 270, 2
			CheckTilt
		End If

		If keycode = CenterTiltKey Then
			Nudge 0, 2
			CheckTilt
		End If
	End If

	If keycode = LeftFlipperKey Then
		VRFlipperButtonLeft.X = VRFlipperButtonLeft.X + 9
	End If

	If keycode = RightFlipperKey Then
		VRFlipperButtonRight.X = VRFlipperButtonRight.X - 9
	End If

	If keycode = PlungerKey Then
		Plunger.PullBack
		PlaySound "plungerpull",0,1,AudioPan(Plunger),0.25,0,0,1,AudioFade(Plunger)
		TimerVRPlunger.enabled = true  ' We enable the plunger timer below..  look for the TimerVPlunger Sub.
		TimerVRPlunger2.enabled = False' We disaable the plunger2 timer below..  look for the TimerVPlunger2 Sub.
	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

	If Keycode=AddCreditKey Then
		PlaySound"Coin3"

		Credit.TimerEnabled=True
	End If

	If Keycode=StartGameKey And Credits>0 And Plunger.TimerEnabled=False Then StartGame
	If keycode=23 Then MsgBox Msg(0),,"         Instructions and Rule Card"
End Sub

Sub Table1_KeyUp(ByVal keycode)
    If Inprogress=True And Tilted=False Then
		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
	End If

    If keyCode = LeftFlipperKey Then
		VRFlipperButtonLeft.X = VRFlipperButtonLeft.X - 9
		StopSound "buzz_left"
	End If

	If keycode = RightFlipperKey Then
		VRFlipperButtonRight.X = VRFlipperButtonRight.X + 9
		StopSound "buzz_right"
	End If

	If keycode = PlungerKey Then
		Plunger.Fire
		PlaySound "plunger",0,1,AudioPan(Plunger),0.25,0,0,1,AudioFade(Plunger)
		TimerVRPlunger.enabled = false  'Disabling the plungertimer.. this is used to animate the plunger
		TimerVRPlunger2.enabled = true  'enabling the plungertimer.. this is used to animate the plunger
	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


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

Sub RightSlingShot_Slingshot
    PlaySound SoundFXDOF("right_slingshot", 105, 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
	Light8.State=Not Light8.State
	AddScore 10
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
	Light8.State=Not Light8.State
	AddScore 10
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


'************************************************************************************************
' Below is the code needed to run the plungers.  Both analog and button press...*****************
'************************************************************************************************

TimerVRPlunger2.enabled = true   '  This sits outside of a sub, and tells the timer2 to be enabled at table load

Sub TimerVRPlunger_Timer
	if VRPlunger.Y < 2358 then VRPlunger.Y = VRPlunger.y + 4  'If the plunger is not fully extend it, then extend it by 4 coordinates in the Y,
End Sub

Sub TimerVRPlunger2_Timer
	VRPlunger.Y = 2285 + (5 * Plunger.Position) - 20  ' This follows our dummy plunger position for analog plunger hardware users.
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
'*********************************************************************

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 / table1.height-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 / table1.width-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 = 5 ' total number of balls
ReDim rolling(tnob)
InitRolling

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

Sub RollingTimer_Timer()
    Dim BOT, b
    BOT = GetBalls

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

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

    For b = 0 to UBound(BOT)
        ' 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
'*****************************************

sub FlipperTimer_Timer()
	FlipperLSh.RotZ = LeftFlipper.currentangle
	FlipperRSh.RotZ = RightFlipper.currentangle

End Sub

'*****************************************
'	ninuzzu's	BALL SHADOW
'*****************************************
Dim BallShadow
BallShadow = Array (BallShadow1,BallShadow2,BallShadow3,BallShadow4,BallShadow5)

Sub BallShadowUpdate_timer()
    Dim BOT, b
    BOT = GetBalls
    ' hide shadow of deleted balls
    If UBound(BOT)<(tnob-1) Then
        For b = (UBound(BOT) + 1) to (tnob-1)
            BallShadow(b).visible = 0
        Next
    End If
    ' exit the Sub if no balls on the table
    If UBound(BOT) = -1 Then Exit Sub
    ' render the shadow for each ball
    For b = 0 to UBound(BOT)
        If BOT(b).X < Table1.Width/2 Then
            BallShadow(b).X = ((BOT(b).X) - (Ballsize/6) + ((BOT(b).X - (Table1.Width/2))/7)) + 6
        Else
            BallShadow(b).X = ((BOT(b).X) + (Ballsize/6) + ((BOT(b).X - (Table1.Width/2))/7)) - 6
        End If
        ballShadow(b).Y = BOT(b).Y + 12
        If BOT(b).Z > 20 Then
            BallShadow(b).visible = 1
        Else
            BallShadow(b).visible = 0
        End If
    Next
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 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





'***** 	Using a merged EXTERNAL SCRIPT FOR TEMPLATE 6 from Bendigos starter set*****
'Original Williams Pinball Sounds recorded onsite editted and reprocessed for size for VP
'all graphics modified and created with Paint Shop Pro 7
'redrawn playfield and backglass courtesy of Brettski .. many thanks!
'Luvthatapex Sept, 28 2003
'*****

Dim TableName			'For defining the table name used when saving credits/highscore
Dim InProgress			'TRUE while game is in progress, FALSE otherwise
Dim Tilted			'TRUE when tilted, FALSE otherwise
Dim TiltSensitivity		'Obvious
Dim State			'Used for playfield objects that can be disabled during TILT
Dim BallInPlay			'Tracks the ball in play
Dim BallsPerGame		'3 or 5
Dim CreditsPerCoin		'1 to 5
Dim Score(4)			'The score itself for up to 4 players
Dim ScoreToAdd			'Used in the AddScore sub
Dim HighScore			'Holds previous high score value
Dim HighScorePaid(4)		'Set to TRUE after any player beats the high score
Dim HighScoreReward		'Set to the number of replays awarded when HIGH SCORE is beaten
Dim ShootAgain			'FALSE to count ball in drain, TRUE not to count
Dim Credits			'Keeps track of the credits
Dim Reset			'Used in Plunger_Timer for reset sequence
Dim Count			'Used in Credit_Timer
Dim Count1			'Used in Tilt_Timer for tilt sensitivity
Dim Count2			'Used in Score1_Timer for number match
Dim Match			'The match number
Dim MatchEnabled		'TRUE to enable number match, FALSE otherwise
Dim MatchDigits			'Determines if match number is 1 or 2 digits e.g 5 or 50
Dim X				'Generic variable used in for-next loops
Dim Replay1			'The scores needed for a replay are held in these 3 variables
Dim Replay2
Dim Replay3
Dim Replay1Paid(4)		'Holds TRUE when each replay has been paid, FALSE otherwise
Dim Replay2Paid(4)
Dim Replay3Paid(4)
Dim Alt				'Used in the alternate sub to alternate light states
Dim AltScore			'Holds the value used to alternate playfield lights
Dim Ones			'These 5 are used in the score motor simulator
Dim Tens
Dim Hundreds
Dim Thousands
Dim TenThousands
Dim ValueP
Dim Player			'The current player number
Dim Players			'The number of players
Dim MaxPlayers			'Determines if table is 1,2 or 4 player
Dim DisplayHighScore		'Don't display high score if there is no saved value
Dim ReelSpeed			'Holds a value to determine the score reel speed
Dim Bells			'Determines if bell sounds are to be played
Dim CountBonus			'Holds TRUE if game has bonus, FALSE otherwise
Dim Msg(12)			'Used to display the rules
Dim aball

Dim Controller

Const NumEMReelsPerPlayer = 6

Dim TValue : TValue = 1
Dim Hole,Section,GWire			'Extra variables needed for gate

' Gate
Const GateClosing = 0
Const GateOpening = 1
Const GateClosed = 2
Const GateOpen = 3

Dim GateState: GateState = GateOpen

'***** Main program code *****

Sub Initialize()

	If B2SOn Then
		Controller.B2SName = "Argosy"
	End If

    Randomize
    Match=Int(Rnd*10)		'Generate a random number for the match counter to start with
    Count=0			'Set variables to a known state
    Count1=0
    Count2=0
    Reset=0
    Hole=0
    Player=1
    BallInPlay=0		'Reset ball counter

	If B2SOn Then
		Controller.B2SSetBallInPlay 32, 0
	End If

	Ball_1.Visible = False
	Ball_2.Visible = False
	Ball_3.Visible = False
	Ball_4.Visible = False
	Ball_5.Visible = False

	vrReelsReset
	SetReel 0, -1, 0	' Init credits to zero

    InProgress=False		'Game not started
    ShootAgain=False		'Make sure we count the balls

    On Error Resume Next    	'Needed if this table has never been saved

    Credits=LoadValue(TableName,"Credits")	'Load CREDITS from previous save
    If Credits="" Then Credits=0    		'If there was no entry, then set to default value

    Credit.Text=Credits						'Place the credits in the display box

	If Int(Credits) > 0 Then
		Light76.State = 1
	End If

	SetReel 0, -1, Int(Credits)				' Set the VR credit reel. Force to int as VBScript can think Credits is a string here because it was read in

	If B2SOn Then
		Controller.B2SSetCredits Credits
	End If

    HighScore=Cdbl(LoadValue(TableName,"HighScore")) 'Load HIGHSCORE from previous save
    If HighScore="" Then HighScore=0 		'If there was no entry, then set to default value

	For X=1 To MaxPlayers
		Score(X)=(LoadValue(TableName,"Player"&X))	'Load scores from previous save game
		If Score(X)="" Then Score(X)=400+(X*10)		'If there was no entry, use default value

		If B2SOn Then
			Controller.B2SSetScore 1,Score(1)
			Controller.B2SSetScore 2,Score(2)
			Controller.B2SSetScore 3,Score(3)
			Controller.B2SSetScore 4,Score(4)
		End If

		Eval("Score"&X).SetValue Score(X)		'Set score reels to highscore value
		Eval("Score"&X).UpdateInterval=200\ReelSpeed	'Set the speed of the reels
	Next

    Shield.TimerInterval=540\ReelSpeed			'Set the score motor speed
End Sub

'***** Hit Subs *****

Sub BallCount_Hit()					'Trigger to count the balls
    PlaySound"FlipperUp"
    Disable False					'Enable any disabled playfield object

    'If BallInPlay<>0 Then Eval("BC"&BallInPlay).Text="" 'Turn off ball-in-play display

    If ShootAgain=False Then CountBall			'Increment ball count unless extra ball
    ShootAgain=False					'Make sure we count the next ball
    Me.Enabled=False					'Disable this trigger
End Sub

Sub TroughSwitch_Hit()					'Prevents the ball being counted if it
    BallCount.Enabled=True				'rolls back from the plunger to the drain
End Sub							'through the cover (accidents DO happen)

Sub TroughSwitch_Unhit()				'Only used for the ball launch sound
    PlaySound"LaunchBall"
End Sub

Sub Gate_Hit()						'Just for the sound
    PlaySound"Click"
End Sub

Sub InPlay_Hit()					'Ball is on playfield,
    BallCount.Enabled=True				'so enable BallCount trigger
End Sub

'***** Scoring and credits *****

'********************************VR DRUM SCORING ROUTINES
'*********************************
' ***************************************************************************
'          BASIC FSS(EM) 1-4 player 6x drums, 1 credit drum CORE CODE
' ****************************************************************************

Dim ix, nxp, npp, reels(5, 7), scores(6,2)
Dim drumObjects
Dim p1Drums, p2Drums, p3Drums, p4Drums

'reset scores to defaults
for nxp =0 to 6
	scores(nxp,0 ) = 0
	scores(nxp,1 ) = 0
Next

'reset EM drums to defaults
For nxp =0 to 3
	For npp = 0 to 6
		reels(nxp, npp) = 0 ' default to zero
	Next
Next

Sub vrReelsReset()
	dim nxp, npp

	ZeroReels

	'reset scores to defaults
	for nxp =0 to 5
		scores(nxp,0 ) = 0
		scores(nxp,1 ) = 0
	Next

	'reset EM drums to defaults
	For nxp = 0 to 3
		For npp = 1 to 6			' reel 0 is credits so don't nuke that
			reels(nxp, npp) = 0		' default to zero
		next
	next
End Sub

Sub ZeroReels
	Dim i, j
	For i = 0 to 3
		For j = 1 to 6
			SetReel i, j, 0
		Next
	Next
End Sub

Sub SetScore(player, ndx , val)
	Dim ncnt

	If val > 0 Then
		If(ndx = 0)then ncnt = val * 100000
		If(ndx = 1)then ncnt = val * 10000
		If(ndx = 2)then ncnt = val * 1000
		If(ndx = 3)Then ncnt = val * 100
		If(ndx = 4)Then ncnt = val * 10
		If(ndx = 5)Then ncnt = val

		scores(player, 0) = scores(player, 0) + ncnt
	End If
End Sub

Sub SetDrum(player, drum, val)
	Dim i

	if player > 3 Then Exit Sub

	If val = 0 then
		If drum = 0 Then	' credit drum
			emp1r25.ObjRotX = 0
		Else
			For i = 0 to 5
				drumObjects(player)(i).ObjRotX = 0
			Next
		End If
	ElseIf drum = 0 Then
		emp1r25.ObjRotX = emp1r25.ObjRotX + val
		Debug.Print "Setting credit reel, val: " & val & ", rot now " & emp1r25.ObjRotX
	Else
		drumObjects(player)(drum - 1).ObjRotX = drumObjects(player)(drum - 1).ObjRotX + val
	End If
End Sub

Sub SetReel(player, drum, val)
	Dim  inc , cur, dif, fix, fval, drumPlayer

	inc = 33.5
	fval = -5 ' graphic seam between 5 & 6 fix value, easier to fix here than photoshop

	If  (player <= 3) or (drum = -1) then
		drumPlayer = player

		If drum = -1 Then
			drum = 0
			drumPlayer = 0
		End If

		cur = reels(drumPlayer, drum)

		If val <> cur then ' something has changed
			If val > cur Then
				dif = val - cur
				fix = 0

				If cur < 5 and cur + dif > 5 Then
					fix = fix - fval
				End if

				dif = dif * inc
				dif = dif - fix

				if drum = 0 Then
					Debug.Print "Incrementing credit reel from " & cur & " to " & val & ", dif: " & -dif
				End If

				SetDrum drumPlayer, drum, -dif
			Else
				If val = 0 Then
					SetDrum player, drum, 0	' reset the drum to abs. zero
				Else
					dif = val - cur
					fix = 0

					If cur > 5 and cur + dif < 5 Then
						fix = fval
					End if

					dif = dif * inc
					dif = dif - fix

					if drum = 0 Then
						Debug.Print "Decrementing credit reel from " & cur & " to " & val & ", dif: " & -dif
					End If

					SetDrum drumPlayer, drum, -dif
				End if
			End if

			reels(player, drum) = val
		End if
	End if
End Sub

Dim vScore1, vScore10, vScore100, vScore1000, vScore10000, vScore100000, Scoreimage
Dim ActiveVRPlayer, nplayer, playr, vrvalue, stemp, cred

Sub AddPointsVR(Points)

	ActiveVRPlayer = Player - 1

	vScore100000 = 0
	vScore10000 = 0
	vScore1000 = 0
	vScore100 = 0
	vScore10 = 0
	vScore1 = 0

	vrvalue = Score(ActiveVRPlayer + 1)

	If vrvalue >= 100000 Then
		vScore100000 = (vrValue - (vrvalue Mod 100000)) / 100000
		vrvalue = vrvalue - (vScore100000 * 100000)
	End If

	If vrvalue >= 10000 Then
		vScore10000 = (vrValue - (vrvalue Mod 10000)) / 10000
		vrvalue = vrvalue - (vScore10000 * 10000)
	End If

	If vrvalue >= 1000 Then
		vScore1000 = (vrValue - (vrvalue Mod 1000)) / 1000
		vrvalue = vrvalue - (vScore1000 * 1000)
	End If

	If vrvalue >= 100 Then
		vScore100 = (vrValue - (vrvalue Mod 100)) / 100
		vrvalue = vrvalue - (vScore100 * 100)
	End If

	If vrvalue >= 10 Then
		vScore10 = (vrValue - (vrvalue Mod 10)) / 10
		vrvalue = vrvalue - (vScore10 * 10)
	End If

	vScore1 = vrValue

	scores(ActiveVRPlayer, 1) = scores(ActiveVRPlayer, 0)
	scores(ActiveVRPlayer, 0) = 0

	For ix = 1 to 6
		reels(ActiveVRPlayer, ix) = 0
	Next

	For ix = 1 to 6
		SetDrum ActiveVRPlayer, ix, 0
	Next

	SetReel ActiveVRPlayer, 1, vScore100000 : SetScore ActiveVRPlayer,0,vScore100000
	SetReel ActiveVRPlayer, 2, vScore10000 : SetScore ActiveVRPlayer,1,vScore10000
	SetReel ActiveVRPlayer, 3, vScore1000 : SetScore ActiveVRPlayer,2,vScore1000
	SetReel ActiveVRPlayer, 4, vScore100 : SetScore ActiveVRPlayer,3,vScore100
	SetReel ActiveVRPlayer, 5, vScore10 : SetScore ActiveVRPlayer,4,vScore10
	SetReel ActiveVRPlayer, 6, vScore1 : SetScore ActiveVRPlayer,5,vScore1
End Sub

Sub AddScore(ScoreToAdd)				'The usual method of adding the score
    If InProgress=False Or Tilted=True Then Exit Sub	'Disable score when TILTed or not started
    Score(Player)=Score(Player)+ScoreToAdd				'Total of current players score
    If ScoreToAdd=AltScore Then Alternate				'Make lights alternate, change match no.

    Eval("Score"&Player).AddValue ScoreToAdd			'Display the score in the correct box
	PlaySound"Cluper"									'Reel advance sound

	AddPointsVR ScoreToAdd

	If B2SOn Then
		Controller.B2SSetScore 1,Score(1)
		Controller.B2SSetScore 2,Score(2)
		Controller.B2SSetScore 3,Score(3)
		Controller.B2SSetScore 4,Score(4)
	End If

'***** The following lines check if a replay has been won and then mark it as paid. *****

    If Score(Player)=>Replay1 And Replay1Paid(Player)=False Then
		AddReplay
		Replay1Paid(Player)=True
    End If

	If Score(Player)=>Replay2 And Replay2Paid(Player)=False Then
		AddReplay
		Replay2Paid(Player)=True
    End If

	If Score(Player)=>Replay3 And RePlay3Paid(Player)=False Then
		AddReplay
		Replay3Paid(Player)=True
    End If

	If Score(Player)>HighScore And HighScorePaid(Player)=False Then
		PayHigh
		HighScorePaid(Player)=True
    End If

	If Bells=True Then PlaySound ScoreToAdd		'Play sounds if turned on
    On Error Resume Next				'Needed if the used sub is deleted
    ScoreSounds ScoreToAdd				'Call the user defined score sounds
End Sub

Sub ScoreSounds(ScoreToAdd)
	If ScoreToAdd=10000 then playsound "1000"
    If ScoreToAdd=20000 then playsound "2000"
End Sub
'***** If AddScore value IS NOT 1/10/100/1000 then use 'MotorScore value' instead *****
'***** e.g. MotorScore 500 to add 500 using the score motor simulator *****

Sub MotorScore(Value)						'Simulates a score motor
    If Shield.TimerEnabled Then Exit Sub			'Acts like a real score motor
    If Value<10 Then Ones=Ones+Value				'Adds the ones
    If Value>9 And Value<100 Then Tens=Tens+(Value\10)		'Adds the 10's
    If Value>99 And Value<1000 Then Hundreds=Hundreds+(Value\100)	'Adds the 100's
    If Value>999 Then Thousands=Thousands+(Value\1000)		'Adds the 1000's
    If Value>9999 Then TenThousands=TenThousands+(Value\10000)		'Adds the 1000's

    PlaySound"Motor"
    Shield.TimerEnabled=True					'Start the scoring
End Sub

'***** Sometimes a lot if triggers will be hit in quick succession, causing the EM Reels *****
'***** to fall behind in the counting, so we use a faster method of updating the reels. *****

Sub FastScore(ScoreToAdd)
    If Tilted=True Then Exit Sub			'Dont score if tilted
    If Bells=True Then PlaySound ScoreToAdd		'Play sounds if turned on

    Score(Player)=Score(Player)+ScoreToAdd		'Add the points to the score

	Eval("Score"&Player).SetValue Score(Player)		'Update the reels

    AddScore 0						'Check if replay has been won
    Alternate						'Change the lights
End Sub

Sub AddReplay()
    PlaySound SoundFXDOF("Knocker", 121, DOFPulse, DOFKnocker)
    'PlaySound "Knocker"					'Play the sound
    AddCredit false
End Sub

Sub PayHigh()						'When HIGH SCORE is beaten, go here
    AddReplay						'Always add at least 1 replay
    If HighScoreReward>1 Then
		Hi.TimerEnabled=True	'Enable the timer for more than 1 replay
	End If
End Sub

Sub AddCredit(playAudio)						'Called by Credit_Timer
    Credits = Credits + 1			'Add a credit to the counter
	SetReel 0, -1, Int(Credits)

	Light76.State = 1

	Credit.Text=Credits					'Update the display

	If B2SOn Then
		Controller.B2SSetCredits Credits
	End If

	If playAudio Then
		PlaySound"StepUp"					'Play stepping sound
	End If
End Sub

Sub SubtractCredit()
    Credits=Credits-1					'Subtract a credit
    PlaySound "Cluper"

	If Credits <= 0 Then
		Light76.State = 0
	End If

	SetReel 0, -1, Int(Credits)

    Credit.Text=Credits					'Update the credit display
    Players=Players+1					'Add a player to current game

	Dim i
	For i = 1 To 6
		Eval("emp" & Players & "r" & i).image = "ScoreReelOn"
	Next

	If B2SOn Then
		Controller.B2SSetCredits Credits
		Controller.B2SSetCanPlay 31, Players
	End If

'    If MaxPlayers>1 Then				'If game is not single player then
'		Eval("Play"&Players).State=LightStateOn		'Light the number of players lights
'    End If
End Sub

'NOTE: The "Tilt_Timer" subtracts .25 from the "Count1" variable every 250ms

Sub CheckTilt()						'Called when table is nudged
    Count1=Count1+TiltSensitivity			'Add to tilt count

    If Count1>15 Then					'If more that 15 then TILTED
		Tilted=True					'Stop game

		Tilt.Text="TILT"				'Display TILT message

		If B2SOn Then
			Controller.B2SSetTilt 33,1
			Controller.B2ssetdata 1, 0
		End If

		Disable True					'Disable slings, bumpers etc

		Dim i,j
		For j=1 To MaxPlayers
			For i=1 to NumEMReelsPerPlayer
				Eval("emp" & j & "r" & i).image = "ScoreReel"
			Next
		Next

    End If
End Sub

'***** Other subs *****

Sub StartGame()
    If InProgress = False Then				'If game is NOT being played
		Plunger.TimerEnabled=True 			'then start a game
    ElseIf BallInPlay = 1 And Players < MaxPlayers Then		'If game IS being played and it's the first ball
		PlaySound"Motor"
		Player1.TimerEnabled=True			'then add a player
    End If
End Sub

Sub NextBall()						'Prepare the next ball, if any left
	Tilted=False					'Reset TILT
    Count1=0						'Reset TILT counter

	Tilt.Text=""					'Get rid of the TILT display

	If B2SOn Then
		Controller.B2SSetTilt 33,0
		Controller.B2ssetdata 1, 1
	End If

    If Bottom4.IsDropped=False then FreeBallGate(GateClosing)	' Reset the outlane ball gate

    If BallInPlay=BallsPerGame And ShootAgain=False And Player=Players Then
		Score1.TimerEnabled=True			'Game is over
    Else							'Deliver the next ball
		Bonus=1						'Bonus should start at 1
		BonusLights					'Now setup the first Bonus Light
		BallRelease.CreateBall
		BallRelease.Kick 90, 7
    PlaySound SoundFXDOF("ballrelease", 110, DOFPulse, DOFContactors)
	'	PlaySound "ballrelease"				'Play the appropriate sound

		If B2SOn Then
			Controller.B2SSetShootAgain 36, 0
		End If
    End If
End Sub

Sub CountBall()
    Player=Player+1					'Next player

	If B2SOn Then
		Controller.B2SSetPlayerUp 30,Player
	End If

    If MaxPlayers>1 Then				'If this is a multi-player game
		If Player>Players Then				'Go back to first player
			Player=1
			BallInPlay=BallInPlay+1				'Next ball
			If B2SOn Then
				Controller.B2SSetPlayerUp 30,Player
			End If
		End If

		if Desktop Then
			Player1.Text = ""
			Player2.Text = ""
			Player3.Text = ""
			Player4.Text = ""

			Eval("Player"&Player).Text = Player		'Turn on player counter
		End If
    End If

	If Desktop Then
		Eval("BC" & BallInPlay).Text = BallInPlay		'Turn on ball-in-play display

		If BallInPlay > 1 Then
			Eval("BC" & (BallInPlay - 1)).Text = ""		'Turn off previous ball-in-play display
		End If
	End If

	If B2SOn Then
	    Controller.B2SSetBallInPlay 32, Ballinplay
	End If

	Ball_1.Visible = False
	Ball_2.Visible = False
	Ball_3.Visible = False
	Ball_4.Visible = False
	Ball_5.Visible = False
	Eval("Ball_" & BallInPlay).Visible = True
End Sub

'***** Timers *****

Sub Plunger_Timer() 				'Used for the reset sequence
    Reset=Reset+1					'Add 1 every time the counter cycles
    Select Case Reset
	Case 1,7:
		PlaySound"Motor"			'Start the motor sound
		Disable True				'Disable playfield objects

	Case 2:
		PlaySound"TargetUp"			'Sound of relay bank resetting
		Players=0					'Reset the number of players]

		vrReelsReset

		If B2SOn Then
			Controller.B2SSetCanPlay 31, 0
		End If

		SubtractCredit

		GOver.Text=""				'Clear GAME OVER message

		If B2SOn Then
			Controller.B2SSetGameOver 35,0
		End If

		For X=1 To MaxPlayers
		    Score(X)=0				'Reset SCORE for all players

			If B2SOn Then
				Controller.B2SSetScore 1,Score(1)
				Controller.B2SSetScore 2,Score(2)
				Controller.B2SSetScore 3,Score(3)
				Controller.B2SSetScore 4,Score(4)
			End If

		    Replay1Paid(X)=False
		    Replay2Paid(X)=False
		    Replay3Paid(X)=False
		    HighScorePaid(X)=False

		    If X>1 And MaxPlayers>1 Then
				'Eval("Play"&X).State=LightStateOff	'Turn off player lights 2,3,4

				If B2SOn Then
					Controller.B2SSetPlayerUp 30,0
				End If
		    End If
		Next

		Tilt.Text=""				'Clear TILT message

		If B2SOn Then
			Controller.B2SSetTilt 33,0
			Controller.B2ssetdata 1, 1
		End If

		BallInPlay=0				'Reset ball counter

		If B2SOn Then
			Controller.B2SSetBallInPlay 32, 0
		End If

		Ball_1.Visible = False
		Ball_2.Visible = False
		Ball_3.Visible = False
		Ball_4.Visible = False
		Ball_5.Visible = False

		InProgress=True				'Game has started
		ShootAgain=False			'Make sure we count the balls
		Tilted=False				'Reset TILT

		If HighScore=0 Then			'There was no saved value, so
		    DisplayHighScore=False		'DON'T display the highscore
		    For X=1 To MaxPlayers
			HighScorePaid(X)=True	'Make sure we don't pay if there is no highscore
		    Next
		End If

		For X=0 To 9				'Turn off match numbers
		    Eval("M"&X).Text=""

			If B2SOn Then
				Controller.B2SSetMatch 34,0
			End If
		Next

		For X=1 To 5				'Turn off ball count numbers
		    Eval("BC"&X).Text=""
		Next

		For X=1 To 4				'Turn off player numbers
		    Eval("Player"&X).Text=""
		Next

	Case 5:
		For X=1 To MaxPlayers
		    Eval("Score"&X).ResetToZero		'Reset score counters
		Next

		If DisplayHighScore=True Then
		    Hi.Text=HighScore			'Display highscore
		    HSBox.Text="High Score"		'Display "High Score" in the box
		End If

	Case 13:
		Reset=0					'Reset this variable for next time
		PlaySound"Motor"			'Continue with motor sound

		If Desktop Then
			BIP.Text = "Ball In Play"			'Display "Ball in play"
			PlayerLabel.Text = "Player"
		End If

		Drain.TimerEnabled=1			'Ready to kick the ball out
		Alternate				'Light the alternating lights
		On Error Resume Next			'If "Table_Reset" sub in missing
		Table_Reset				'Go to the user defined reset sub
		Me.TimerEnabled=False			'Disable this timer
    End Select
End Sub

Sub Player1_Timer()					'Slight delay when adding players
    SubtractCredit
    Me.TimerEnabled=False
End Sub

Sub Drain_Timer()
    If DisplayHighScore=True Then
		Hi.Text=HighScore	'Display the current HIGH SCORE
	End If

    NextBall						'Reset tilt, continue game
    Me.TimerEnabled=0
End Sub

Sub Credit_Timer()					'When a coin is inserted, go here
    Count=Count+1
    Select Case Count
	Case 7:PlaySound"Motor"
	Case 8:If CreditsPerCoin>1 Then AddCredit true
	Case 9:If CreditsPerCoin>2 Then AddCredit true
	Case 10:If CreditsPerCoin=5 Then AddCredit true
	Case 11:AddCredit true								'Always add at least 1 credit
	Case 12:If CreditsPerCoin>3 Then AddCredit true
		Count=0
		Me.TimerEnabled=False
    End Select
End Sub

Sub Hi_Timer()						'Pay any HIGHSCORE award greater than 1
    Count=Count+1
    Select Case Count
		Case 1:AddReplay
		Case 2:If HighScoreReward>2 Then AddReplay
		Case 3:If HighScoreReward>3 Then AddReplay
		Case 4:If HighScoreReward=5 Then AddReplay
				Count=0
				Me.TimerEnabled=False
    End Select
End Sub

Sub Tilt_Timer()						'Used to simulate a tilt bob
    If Count1>0 Then Count1=Count1-0.25				'Subtract .25 every 250ms
End Sub

Sub Score1_Timer()						'Used for GAME OVER sequence
    Count2=Count2+1						'Increment the counter
    Select Case Count2
	Case 1:PlaySound"Motor"					'Play the score motor sound
	Case 2:If MatchEnabled=True And Players>1 Then  	'If the match feature is enabled
		  If MatchDigits=1 Then			'and is only 1 digit then for player 2
		     If Match=Score(2) Mod 10 Then AddReplay    'If numbers match, give a replay
		  Else						'Match is 2 digits
		     If Match=Score(2)\10 Mod 10 Then AddReplay
		  End If
	       End If

	Case 4:If MatchEnabled=True Then			'If the match feature is enabled
		  If MatchDigits=1 Then			'and is only 1 digit then for player 1
		     If Match=Score(1) Mod 10 Then AddReplay    'If numbers match, give a replay
		     Eval("M"&Match).Text=Match			'Turn on the match number display
		  Else						'Match is 2 digits
		     If Match=Score(1)\10 Mod 10 Then AddReplay
		     Eval("M"&Match).Text=(Match&"0")		'Turn on the match number display
		  End If
	       End If

	Case 6:If MatchEnabled=True And Players>2 Then		'If the match feature is enabled
		  If MatchDigits=1 Then			'and is only 1 digit then for player 3
		     If Match=Score(3) Mod 10 Then AddReplay	'If numbers match, give a replay
		  Else						'Match is 2 digits
		     If Match=Score(3)\10 Mod 10 Then AddReplay
		  End If
	       End If

	Case 8:If MatchEnabled=True And Players>3 Then		'If the match feature is enabled
		  If MatchDigits=1 Then			'and is only 1 digit then for player 4
		     If Match=Score(4) Mod 10 Then AddReplay	'If numbers match, give a replay
		  Else						'Match is 2 digits
		     If Match=Score(4)\10 Mod 10 Then AddReplay
		  End If
	      End If

		  Eval("BC" & BallInPlay).Text = ""			'Turn off ball in play numbers
		  Eval("Player" & Player).Text = ""			'Turn off ball in play numbers
	      GOver.Text="Game Over"				'Display GAME OVER

		  If B2SOn Then
			Controller.B2SSetGameOver 35,1
			Controller.B2SSetmatch 34,match
		  End If

	      BIP.Text=""					' Turn off BALL IN PLAY
		  PlayerLabel.Text = ""			' Turn off PLAYERS

		  If B2SOn Then
            Controller.B2SSetBallInPlay 32, 0
		  End If

 		  Ball_1.Visible = False
		  Ball_2.Visible = False
		  Ball_3.Visible = False
		  Ball_4.Visible = False
		  Ball_5.Visible = False

	Case 9:SaveValue TableName,"Credits",Credits		'Save the credits
		  If B2SOn Then
			Controller.B2SSetPlayerUp 30,0
		  End If

	      For X=1 To Players
		  If Score(X)>HighScore Then
			SaveValue TableName,"HighScore",Score(X)'Save the HighScore
			HighScore=Score(X)
			Hi.Text=HighScore
			HSBox.Text="High Score"
		  End If
		  SaveValue TableName,"Player"&X,Score(X)	'Save scores for next game
		Next
		InProgress=False				'Game is finished
		Count2=0					'Reset the counter for next time

		Dim i,j
		For j=1 To MaxPlayers
			For i=1 to NumEMReelsPerPlayer
				Eval("emp" & j & "r" & i).image = "ScoreReel"
			Next
		Next

		On Error Resume Next				'If "Game_Over" sub is missing
		Game_Over					'Call user code
		Me.TimerEnabled=False				'Disable this timer
    End Select
End Sub

Sub Shield_Timer() 'Timer used for the motor simulator. I am using the built-in timer for a wall.
    If Ones>0 Then AddScore 1:Ones=Ones-1		'Add 1 to score, subtract 1 from counter
    If Tens>0 Then AddScore 10:Tens=Tens-1		'The same for 10's, etc
    If Hundreds>0 Then AddScore 100:Hundreds=Hundreds-1
    If Thousands>0 Then AddScore 1000:Thousands=Thousands-1
    If TenThousands>0 Then AddScore 10000:TenThousands=TenThousands-1
    If Ones+Tens+Hundreds+Thousands+TenThousands=0 Then
	StopSound"Motor"
	Me.TimerEnabled=False				 'If nothing left, then exit timer
    End If
End Sub

Sub Table1_Init()
	LoadEM
	TableName="Argosy"	'Place your table name here
	MaxPlayers=4		'4 for 4 player, 2 for 2 player, 1 for single player game
	BallsPerGame=5		'3 or 5 balls per game
	CreditsPerCoin=1	'1 to 5 credits per coin
	HighScoreReward=3	'The number of replays to award when HIGH SCORE is beaten (1-5)
	MatchEnabled=True	'TRUE for match feature enabled, FALSE otherwise
	MatchDigits=2		'Set the number of match digits to 1 for "0" or to 2 for "00"
	Bells=True			'TRUE to play bell sounds, FALSE for no bells
	CountBonus=True		'TRUE to count bonus at drain, FALSE otherwise
	DisplayHighScore=True	'Display the high score if it has been saved
	AltScore=1			'The score value needed to alternate the lights, 0=disabled
	TiltSensitivity=6	'0-15, 6=normal - a higher number is more sensitive, 0=disabled
	ReelSpeed=3			'Defines the speed of the reels, 1=slow, 9=fast, 3=default
	Replay1=430000		'Place the score needed for replays in these 3 variables
	Replay2=640000
	Replay3=750000
	PrepareRules		'Prepare the rule card

	p1Drums = Array(emp1r1, emp1r2, emp1r3, emp1r4, emp1r5, emp1r6)
	p2Drums = Array(emp2r1, emp2r2, emp2r3, emp2r4, emp2r5, emp2r6)
	p3Drums = Array(emp3r1, emp3r2, emp3r3, emp3r4, emp3r5, emp3r6)
	p4Drums = Array(emp4r1, emp4r2, emp4r3, emp4r4, emp4r5, emp4r6)

	drumObjects = Array(p1Drums, p2Drums, p3Drums, p4Drums)

	Initialize			'Call main Init sub in the external script
	LightsOut			'NEW
'	ShootAgain=False
End Sub

'Calls to the following 4 subs are error checked, so the subs can be deleted if not needed

Sub UserKeyUp(ByVal Keycode)	'Custom "KeyUp" for this table can be placed here
End Sub

Sub UserKeyDown(ByVal Keycode)	'Custom "KeyDown" for this table can be placed here
End Sub

Sub Table_Reset()				'User defined reset code can be placed here
End Sub

Sub Game_Over()					'User defined game over code can be placed here
End Sub

Sub Drain_Hit()
	PlaySoundAt "Drain", Drain
	Drain.DestroyBall

'	if NoPointsScored and (Tilt = 0) Then
'		Playsound "FD_DrainwithBallrelease"
'		ReleaseSameBallTimer.enabled = True
'	Else
'		AwardBonus
'	End If

	X2.TimerEnabled=True '_Timer
End Sub


'***** Object and light control *****
'***** Any lights that need to be extinguished when tilted should be placed in the collection
'***** "TiltLights". They will be set back to the previous state for the next ball.
Sub Disable(State)										'Disable or enable objects when TILTed
	'LeftSlingShot.Disabled=State
	'RightSlingShot.Disabled=State
	'Put bumpers etc here. If the object supports ".Disabled" then use "Object.Disabled=State"
	'Or if the object instead supports ".Enabled" then use "Object.Enabled=Not State"
	If State=True Then
		LeftFlipper.RotateToStart						'Move flippers to start position
		RightFlipper.RotateToStart
		LightSeq.Play SeqAllOff							'Extinguish lights when tilted
		StopSound "buzz_left"
		StopSound "buzz_right"
	Else
		LightSeq.StopPlay								'Turn lights back on
	End If
End Sub

Sub Alternate()											'Alternates playfield lights
	If Shield.TimerEnabled Then Exit Sub				'Exit if motor is running
	If AltScore=0 Then Exit Sub							'If disabled then exit
	Match=(Match+1) Mod 10								'Cycle the match number (0-9)
	Alt=Match Mod 2										'Is it an odd or even number
	If LeftOutLane.State=1 or RightOutLane.State=1 then LeftOutLane.State=Alt
' Add lights above here which are on when number is ODD
' As NOT returns -1 or -2, we need to subtract 2 to get 0(off) or 1(on)
	Alt=Not Alt-2									'Invert the state for the next lot of lights
' Add lights below here which are on when number is EVEN
	If LeftOutLane.State=1 or RightOutLane.State=1 then RightOutLane.State=Alt
End Sub

'***** Rules *****
Sub PrepareRules()								'The table rules should be placed in these lines
	Msg(0)=TableName&Chr(10)&Chr(10)
	Msg(1)="________________________________________________________________"
	Msg(2)=" Top Center Rollover Lane Opens Gate and Scores 10,000 When Lit."
    Msg(3)="  Lane Lites for 10,000 When Bonus Is At Top."
	Msg(4)=" Making All Four Drop Targets Scores Lit Value And Advances "
    Msg(5)="  Value Of Drop Targets And Eject Hole To Next Highest Value."
	Msg(6)=" Scoring Special Resets Drop Target value to 30,000 and "
    Msg(7)="  Eject Hold Value to Double Bonus."
	Msg(8)=" Special Scores 1 Credit"
	Msg(9)=" Matching Last Two Numbers Of Score To Number That Appears"
	Msg(10)=" On Back Glass After Game Is Over Scores 1 Credit."
	Msg(11)="________________________________________________________________"
End Sub

'***** Demo of how to do BONUS LIGHTS ****** To remove this demo, just remove all the script from
'***** here to "END OF BONUS DEMO", remove the collections TENSLIGHTS, HUNDREDSLIGHTS and
'***** TRIGGERS, the 6 lower playfield triggers, the top trigger and the bonus lights and
'***** their decals, and set "CountBonus=False" in Sub Table_Init

Dim Bonus,Multiplier,Counter,FastBonus				'The variables used in the demo

FastBonus=True										'Set to FALSE to count by 10's
Counter=0											'Set to a known state
Multiplier=1										'Set to 1 when the table loads - this
'would normally go in "Sub Table_Init", but is put here so it is removed with the demo

Sub Trigger1_Hit()									'The top trigger
	If Multiplier=2 Then Exit Sub 'restrict to 2x highest multiplier
'		If Multiplier>1 Then Eval("X"&Multiplier).State=LightstateOff

	' Free double bonus on last ball
'	If ballinplay=BallsPerGame then
'		Multiplier=Multiplier+1
'		Eval("X"&Multiplier).State=LightStateOn
'	End If
End Sub

Sub AddBonus
	If Bonus < 10 Then
		PlaySound "FlipperUp"
		Bonus = Bonus+1								'Add 1 to BONUS counter
		BonusLights									'Process the bonus lights

		If Bonus = 10 then
			BonusLight10.State = 1
			Top3.State = 1
		End If
	Else
		'Force last bonus light on and previous off, then lite
		'the center rollover for 10k pts
		Bonus = 10: BonusLight10.State = 1: BonusLight9.State = 0: Top3.state = 1
	End If
End Sub

REM The bonus lights are in 2 collections called TENS
Sub BonusLights()
	For X=1 To TensLights.Count					'Scan the TENS lights and compare them to the
		If Bonus Mod 10=X Then					'tens digit of the BONUS variable to
			TensLights(X-1).State=LightStateOn	'determine if the light should be ON or OFF
		Else
			TensLights(X-1).State=LightStateOff
		End If
	Next
End Sub

Sub X2_Timer()									'Bonus score timer(X2 light)
	Counter=Counter+1
	Select Case Counter
		Case 1:If Bonus>10 And FastBonus=True Then
					MotorScore 100*Multiplier
					Bonus=Bonus-10				'Subtract 10 from bonus left
				Else
					'MotorScore 10000*Multiplier
					AddScore 10000*Multiplier
					Bonus=Bonus-1				'Subtract 1 from bonus left
					Bonuslights
				End If

		Case 6:'BonusLights						'Change the bonus lights
			   Counter=0						'Reset the counter for the next count
			   If Bonus<1 Then					'If all paid then -
					X2.State=LightStateOff		'Turn off the multiplier lights
					Multiplier=1				'Set multiplier to 1
					PlaySound"Motor"			'Play the sound once
					Drain.TimerEnabled=True		'Call the timer to create the next ball
					Lightsout					'NEW! Turn off playfield
					ResetTargets				'NEW! reset targets
					Bonus=1						'Bonus should start at 1
					TValue=1
					TValueLights
					BonusLights
					Me.TimerEnabled=False		'And disable this timer
			   End If
	End Select
End Sub

Sub PopBumper_Init()
	'Ring.IsDropped=True							'Raise the ring
	'SkirtDark.IsDropped=False					'Use the dark skirt because
	'Me.State=LightStateOn						'the light is OFF
End Sub

Sub PopBumper_Hit()
		DOF 109, DOFPulse
'			PlaySound"Bumper"
	Alternate
	AddScore 100
	'Ring.IsDropped=False						'Drop the ring (wall is upside down)
	Me.TimerEnabled=true						'Call the timer to raise the ring
End Sub

Sub PopBumper_Timer()
	'Ring.IsDropped=True							'Raise the ring
	Me.TimerEnabled=False						'Disable the timer
End Sub

Sub Bumper1_Init()
	'Ring2.IsDropped=True							'Raise the ring
	'SkirtDark2.IsDropped=False					'Use the dark skirt because
	'Me.State=LightStateOn						'the light is OFF					'because the light is off
End Sub

Sub Bumper1_Hit()
	DOF 107, DOFPulse
'			PlaySound"Bumper"
	Alternate
	AddScore 100
	'Ring2.IsDropped=False						'Drop the ring (wall is upside down)
	Me.TimerEnabled=true						'Call the timer to raise the ring
End Sub

Sub Bumper1_Timer()
	'Ring2.IsDropped=True							'Raise the ring
	Me.TimerEnabled=False						'Disable the timer
End Sub

Dim Target,BCount
BCount=0

Sub T1_Dropped()
	MotorScore 1000
	AddBonus
	PlaySound"Reels"
	CheckTargets
End Sub

Sub T2_Dropped()
	MotorScore 1000
	AddBonus
	PlaySound"Reels"
	CheckTargets
End Sub

Sub T3_Dropped()
	MotorScore 1000
	AddBonus
	PlaySound"Reels"
	CheckTargets
End Sub

Sub T4_Dropped()
	MotorScore 1000
	AddBonus
	PlaySound"Reels"
	CheckTargets
End Sub

Sub CheckTargets()
	If T1.IsDropped=1 and T2.IsDropped=1 and T3.IsDropped=1 and T4.IsDropped=1 then
		'Increment the target value
		If light1.state=1 then AddScore 10000 'Score 10k
		If light2.state=1 then AddScore 30000 'Score 30k
		If light3.state=1 then AddScore 50000 'Score 50k
		If light4.state=1 then AddReplay      'Score Replay

		AddTvalue
		ResetTargets
	End If
End Sub

Sub AddTValue()
	Tvalue=Tvalue+1
	If Tvalue=2 then light5.state=1:light6.state=0:light7.state=0 'increment Hole Value for Double Bonus
	If Tvalue=3 then light6.state=1:light5.state=0:light7.state=0 'increment Hole Value for Extra Ball Lane
	If Tvalue=4 then light7.state=1:light5.state=0:light6.state=0 'increment Hole Value for Special
	TValueLights
End Sub

Sub TValueLights()
	If Tvalue=1 then light1.state=1 'increment Target Light
	If Tvalue=2 then light2.state=1:light1.state=0
	If Tvalue=3 then light3.state=1:light2.state=0:light1.state=0
	If Tvalue=4 then light4.state=1:light3.state=0:light2.state=0:light1.state=0
End Sub

Sub T1_Timer()
	LeftSpecial.State=1:LeftOutLane.State=1:top1.state=1:top2.state=1
	BCount=Bcount+1									'Count from 0 to 25
	If Bcount>25 Then PlaySound"StepUp"

	Select Case BCount
		Case 15:PlaySound"Motor",-1						'After delay start motor
		Case 18,19,20:AddScore 1000						'Score 300 for all targets down
		Case 21:T1.IsDropped=False						'Raise the targets in sequence
		Case 22:T2.IsDropped=False
		Case 23:T3.IsDropped=False
		Case 24:T4.IsDropped=False
		Case 25:BCount=0								'reset the counter and
				StopSound"Motor"
				Me.TimerEnabled=False					'disable the timer
	End Select
End Sub

Sub ResetTargets()
	'PlaySound"Motor"						'After delay start motor
    PlaySound SoundFXDOF("Motor", 204, DOFPulse, DOFContactors)
	T1.IsDropped=False:T2.IsDropped=False:T3.IsDropped=False:T4.IsDropped=False
	'The last target is up, so
	BCount=0								'reset the counter and
	StopSound"Motor"
End Sub

'**********************************************************************
'Argosy Specific Stuff
'**********************************************************************
Sub Lightsout
	For X=1 To PlayfieldLights.Count					'Scan the TENS lights and compare them to the
		PlayfieldLights(X-1).State=LightStateOff
	Next

	For X=1 To TensLights.Count					'Scan the TENS lights and compare them to the
		TensLights(X-1).State=LightStateOff
	Next
End Sub

Sub Trigger5_Hit() 'LeftOutLane
 	MotorScore 5000
	If LeftOutLane.State=1 then
		ShootAgain=true:Shoot.State=1
		If B2SOn Then
			Controller.B2SSetShootAgain 36, 1
		End If
	End If
End Sub

Sub Trigger6_Hit():AddScore 1000:AddBonus:End Sub 'LeftInLane
Sub Trigger2_Hit():AddScore 1000:AddBonus:End Sub 'RightInLane

Sub Trigger3_Hit() 'RightOutLane
	MotorScore 5000
	If RightOutLane.State=1 then
		ShootAgain=true:Shoot.State=1

		If B2SOn Then
			Controller.B2SSetShootAgain 36, 1
		End If
	End If
End Sub

Sub Trigger9_Hit()
 	MotorScore 500
	If RightSpecial.State=1 then AddReplay
End Sub

Sub Trigger13_Hit()
	MotorScore 500
	If LeftSpecial.State=1 then ShootAgain=true
End Sub

Sub Wall132_Slingshot()
	AddBonus:MotorScore 500
End Sub

Sub BallKicker_Hit
	Set aBall=ActiveBall
	LiftBall.Enabled=1
	If Bonus>0 Then
'		PlaySound"Motor",-1								'Play continuous motor sound and,
'   	X2.TimerEnabled=True
	Else
		BallKicker.TimerEnabled=1						'Call the timer to drop the guide
	End If
End Sub

Sub Spinner1_Spin()
	If Not Light8.State=0 then
	playsound "spinner2"
		motorscore 1000
	Else
		motorscore 100
	End If
End Sub

Sub Wall019_Slingshot()
    PlaySound SoundFXDOF("bumper", 214, DOFPulse, DOFContactors)
	'playsound"bumper"
	Motorscore 10
	Light8.State=Not Light8.State
End Sub

Sub top2trigger_Hit()
	AddBonus:Motorscore 500
	Wall_Top2.isdropped=true:playsound "buzz"
End Sub

Sub top2trigger_UnHit()
	Wall_Top2.isdropped=false
End Sub

Sub top1trigger_Hit()
	AddBonus:Motorscore 500
	Wall_Top1.isdropped=true:playsound"buzz"
End Sub

Sub top1trigger_UnHit()
	Wall_Top1.isdropped=false
End Sub

Sub Toptrigger_Hit() 'Top Mid Rollover
	' Gate always opens when hit!
	FreeBallGate(GateOpening)

	If Top3.State=1 then
		AddScore 10000
	Else
		AddScore 1000:AddBonus
	End If

	' Skill shot - first time the lane is hit, advance the target bank reward
	If Light1.State = 1 Then
		AddTValue
	End If

End Sub

Sub Wall031_Slingshot()
	Motorscore 10
	Light8.State=Not Light8.State
End Sub

Sub wire2_Hit()
	playsound"click"
End Sub

Sub Wire5_Hit()
	playsound"click"
End Sub

Sub Kicker1_Init
	FreeBallGate(GateClosing)								'Call this to remove the unused parts
End Sub

Sub Kicker1_Hit
	If light5.state=1 then x2.state=1:Multiplier=2 'award double bonus
	If light6.state=1 then LeftOutLane.State=1 ':RightOutLane.State=1 'award Extra Ball Lane
	If light7.state=1 then AddReplay  'award Special

	PlaySound"Motor"
	MotorScore 5000								'Score 5000
	Me.TimerEnabled=True						'Call Kicker1_Timer
End Sub

Sub Kicker1_Timer
	Kicker1.Kick 230,10
    PlaySound SoundFXDOF("Kicker", 118, DOFPulse, DOFContactors)						'Kick the ball out after a delay
'	PlaySound"Kicker"
	Me.TimerEnabled=False
End Sub

Sub FreeBallGate(gateDir)								'Determine which direction the gate has to move

	If (GateState = GateClosed and gateDir = GateOpening) Or (GateState = GateOpen and gateDir = GateClosing) Then
		GateState = gateDir

		If GateState = GateClosing Then
			Section = 4
		Else
			Section = 1
		End If

		Pin.TimerEnabled=True
	End If
End Sub

Sub Bottom4_Hit
	Me.TimerEnabled = True
End Sub

Sub Bottom4_Timer
	FreeBallGate(GateClosing)
	Me.TimerEnabled = False
End Sub

Sub bottom1_Slingshot
	If GateState = GateClosed Then
		FreeBallGate GateOpening
	End If
End Sub

Sub bottom1_Hit
	If GateState = GateClosed Then
		'FreeBallGate GateOpening
	End If
End Sub

Sub Pin_Timer									'Used to make the gate sections visible
	For Each GWire In BallGate					'Drop all walls that make up the gate
		GWire.IsDropped=1
	Next

	Eval("Bottom"&Section).IsDropped=False

	If GateState = GateClosing Then			'Gate is closing
		Section = Section-1					'Subtract 1 from variable

		If Section < 1 Then
			GateState = GateClosed			' Done, gate is closed
			Me.TimerEnabled = False
			Light9.State = 0
		End If
	Else									'Gate is opening
		Section = Section + 1				'Add 1 to variable

		If Section > 4 Then
			GateState = GateOpen			' Done, gate is open
			Me.TimerEnabled = False
			Light9.State = 1
		End If
	End If
End Sub

Sub Table1_Exit

    If B2SOn Then Controller.Stop

End Sub