ScriptVersion = "1.52"
'----
' Firepower V1.5 - Extracted into script; different ball images; new
'   backdrop shot.  startsound no longer needed, thanks to new VPM 1.12!
'   Also added a tilt routine because I don't trust vbs3.02 to be quite
'	correct in its handling, and vbs2.34 don't handle the tilts right.
'	Also added some reels to the backglass for special effects...
'	[script update for v1.5; see below]
' Firepower V1.4 - Standing Targets That Work!
' Firepower V1.3C - 'R' for rule sheet; better flipper strengths
' Firepower V1.3B - New spinner image!
' Firepower V1.3A - Drop targets and standing targets merged by overlay.
' Firepower V1.3 - original upgrade to Cutter's phenomenal table!
'
' Release 2.0 is awaiting a new playfield shot.
' Release 1.5 is waiting for me to get off my arse and make the backdrop
' work!
'
' Williams  February 1980
' Model number   : 497
' Production run : 17410
' (Internet Pinball Database)
'
' V1.5 by greywolf 2 April 2002
'
' Wanna mod it?  Let's talk:  greywolf@starwolf.com.  If it's a simple
' graphic mod, I'll incorporate it, re-release it and credit you.
' If it's a functional mod, please fill me in on what your intentions
' are.  I'm always looking for better techniques!  Send me a note
' explaining what you've done, and send me the modded table for my
' own records.
'
' Requires VPinMame, latest S6.VBS and the ROM set (frpwr_l2.zip).
' Copy the fonts (Computer.ttf and Compstyl.ttf) to your system Fonts
' folder.
'
' Thanks to:
'	Cutter	(for the original table),
'	AP		(for the font, in retrospect),
'	Guru	(for the table shot, in retrospect),
'	WPCmame (for IMMENSE help with the dialog box and flipper relay)
'	Neurokinetik (for the new spinner shots), and
'	The VP crew for the plethora of new sounds to choose from!
'-----------------------------------------------------------------
' V1.2 by Cutter
' This table cannot be modified without my permission. (Plz respect this)
'
' Requires VPinMAME, latest S6.VBS and the correct ROM set (frpwr_l2.zip).
' Copy the font (Computer.ttf) to your windows\fonts folder.
'
' Get the latest version from http://warp9.to/cutter
'
' Thanks to:
'     AP   (for the font),
'     Guru (for the playfield pics) and
'     Nicky Special (for the backdrop) !
'##########################################################
' NOTE:
' -----
' Just like the 'real' FirePower, this version can be converted to use
' drop-targets instead of the normal standups.
' To do so, just change the drop var below to 'TRUE'! [But see script
'													   notes.  --*greywolf;]
' Only the 6 center targets will be droppable, not the 3 on the right side.
'
' What's new
' V1.51
' -----
' All feature variables are gone.  They are now replaced by a dip switch
' dialog box.
' We now use the vpmNudge.SolGameOn handler, as it works correctly.
'
' V1.5
' ----
' New Backdrop
' Functional part of script set outside in a separate script file
' New Rules explanation dialog
' FIRE and POWER activated on backdrop.
' Random balls (occasional black ball).
' Implemented a tilt mechanism that works.
'
'
' V1.4 (TB6!  Yea, verily!)
' ----
' ROUND STANDING TARGETS WITHOUT THE NEED FOR DECALS!
'
' ----------
' V1.3C (Final Release before DogFood 6)
' Found good balance for flippers; some of you may still think it a bit strong.
' Added Rulesheet via 'R' key.
'
' V1.3B (More Improvements release)
' -----
' Reset table slope to 7
' Still fiddling with flippers
' New spinner image (front/back) courtesy of Neurokinetik
'
' V1.3A (Bug fix release)
' -----
' Overlaid standing targets atop drop targets; if drop=true,
'	droptargets are used; else standers are used.  Elasticity is different.
' Modified elasticity of wood-tone "walls" (really floors with height 1) to
'	match the rest of the table (0.4; 0.5 for small posts; 0.55 for standing
'	targets)
' Backed off the flipper speed
' Reset bumper sensitivity to 1
' Added a startup dialog to select standing or drop targets;
'	can't make this run-time due to the way switches and drop targets are
'	initialised.  Sorry, folks.
'
' V1.3
' ----
' Changed lamp colours;
' Fixed drop target code;
' Increased overall elasticity and changed slope to 7 degrees
' Fixed fonts on F-I-R-E;
' Added double-breaker targets between standups (to simulate a double hit);
' Changed spinner to manual control via Spinner_spin/spin_timer;
' Worked around 'stuck flasher' bug in VPMame;
' Simulated more brilliant flashing for FIRE/POWER;
' Added logic for Firepower startup sound;
' ...would love to be able to select drops or standups at run-time,
' but as I can't have that, I have to save two tables, largely due to
' elasticity problems.
'
' V1.2
' ----
' Bugfixes, should now work on the latest DF5.
' Changed lampcolor on a few lamps.
' V1.1
' ----
' Changed flipper speed slightly.
' Changed lampcolor on 3 lamps.
' And a few more things that i can't remember now...


' Enjoy!

' /Cutter  (tels66@hotmail.com)
' greywolf (greywolf@starwolf.com)

'------------------------------------------------------------------------------

Sub InitVPM()
	with Controller
		.GameName = "frpwr_l2"				' Use specified ROM set.
		.SplashInfoLine = TableName & Tableversion & vbNewLine & "Table Adapted by Cutter, Mods by Greywolf" & vbNewLine & "http://warp9.to/cutter" & vbNewLine & "Modifications by Greywolf"
		.HandleKeyboard = False
		.ShowTitle = False
		.ShowFrame = False
		.ShowDMDOnly = True
		.DIP(0) = &H80 ' Set US
	end with
	On Error Resume Next
		Controller.Run
		If Err Then MsgBox Err.Description
	On Error Goto 0
End Sub
ExtraKeyHelp = vpmKeyName(keyRules) & vbTab & "Show Rules"
Const UseSolenoids = True
Const UseLamps     = True

Const SSolenoidOn   = "slingshot"
Const SSolenoidOff  = "soloff"
Const SFlipperOn    = "FlipperUp"
Const SFlipperOff   = "FlipperDown"
Const SCoin = "Quarter"

Set LampCallback	= GetRef("UpdateMultipleLamps")

'SolCallback(sKnocker)			= "vpmSolSound ""Knocker"","
SolCallback(sKnocker)			= "Firepower_Credit"

SolCallback(sLLFlipper)			= "vpmSolFlipper LeftFlipper, Nothing,"
SolCallback(sLRFlipper)			= "vpmSolFlipper RightFlipper, Nothing,"

SolCallback(sKickBack)			= "vpmSolAutoPlunger KickBack,10,"
'SolCallback(sFlasher)          = "vpmFlasher Array(LFire,LPower,FFire,FPower),"
SolCallback(sFlasher)			= "flashfp"
SolCallBack(sTableRelay)		= "vpmNudge.SolGameOn"
'---

Sub StandOrDrop ()
	Dim msgbstyle, msgbtitle, retv
	msgbstyle = vbYesNo+vbInformation+vbDefaultButton2
	msgbtitle = "Make 1-6 center targets drop targets?"
	if drop <> TRUE and drop <> FALSE then
		retv = msgBox("Shall I use drop targets for targets 1-6?", msgbstyle, msgbtitle)
		if not (retv = vbNo) then
			drop = TRUE
		else
			drop = FALSE
		end if
	end if
end sub

Dim bsTrough, bsLeft, bsRight, bsUpper, OhNo, LDrops, RDrops
Sub Firepower_Init()
'	StandOrDrop
	InitVPM
	dim targ
	vpmInit Me
	fpOptions = LoadValue("Frpwr_l2","Options")
	If fpOptions = "" Then fpOptions = &H07 ' default
	drop = (fpOptions And &H01) > 0
	randomballs = (fpOptions And &H02) > 0
	flashbackdrop = (fpOptions And &H04) > 0

	if(drop=TRUE) then
		XNote.text = "[using drop targets]"
		vpmCreateEvents Switches

		Set LDrops = New cvpmDropTarget
		With LDrops
			.InitDrop Array(TCDrop1,TCDrop2,TCDrop3),Array(17,18,19)
			.AllDownSw = 20
			.InitSnd "soloff","dtreset"
			.CreateEvents "LDrops"
		end with
		SolCallback(sResetBank1) = "LDrops.SolDropUp"


		Set RDrops = New cvpmDropTarget
		With RDrops
			.InitDrop Array(TCDrop4,TCDrop5,TCDrop6),Array(21,22,23)
			.AllDownSw = 24
			.InitSnd "soloff","dtreset"
			.CreateEvents "RDrops"
		end with
		SolCallback(sResetBank2) = "RDrops.SolDropUp"

		for each targ in CStand
			targ.isdropped = true
		next
	else
		XNote.Text = "[using standing targets]"
		vpmCreateEvents AllSwitches
	end if
	for each targ in CDrops
		targ.isdropped = True
	next
	vpmMapLights AllLamps

' Set up for the nudge thing.  We just don't call SolGameOff().
	vpmnudge.TiltSwitch = swTilt
	vpmnudge.Sensitivity = 5
	vpmnudge.TiltObj = array(bumper1,bumper2,bumper3,bumper4,leftslingshot,rightslingshot)
	'OhNo=FALSE

	Set bsTrough = New cvpmBallStack
	with bsTrough
		.Balls=3
		.InitSw 9,57,58,51,0,0,0,0
		.InitKick BallRelease,100,2
		.InitEntrySnd "ballrel",""
		.InitExitSnd "slingshot",""
		'.BallImage="BLACK"
		.BallImage="shinyball"
	end with
	SolCallback(sBallRelease) = "bsTrough.SolOut"
	SolCallback(sOutHole) = "bsTrough.SolIn"

	Set bsLeft = New cvpmBallStack
	with bsLeft
		.InitSaucer LeftEject,13,165,5
		.KickForceVar = 2
		.InitExitSnd "slingshot",""
	end with
	SolCallback(sLeftEject) = "bsLeft.SolOut"

	Set bsRight = New cvpmBallStack
	with bsRight
		.InitSaucer RightEject,30,135,5
		.KickForceVar = 4
		.InitExitSnd "slingshot",""
	end with
	SolCallback(sRightEject) = "bsRight.SolOut"

	Set bsUpper = New cvpmBallStack
	with bsUpper
		.InitSaucer UpperEject,36,265,4
		.KickForceVar = 4
		.InitExitSnd "slingshot",""
	end with
	SolCallback(sUpperEject) = "bsUpper.SolOut"

	KickBack.PullBack

	XVersion.text = Tableversion
	fpLoadBalls
End Sub

Sub TReject_Hit () : playsound "entereject" : End Sub
Sub TLeject_Hit () : playsound "entereject" : End Sub
Sub TUeject_Hit () : playsound "entereject" : End Sub

Sub XCredits_Init ()
		me.text = "FIREPOWER" & vbNewLine
		me.text = me.text & "(C)1980 WILLIAMS ELECTRONICS INC." & vbNewline
		me.text = me.text & "TABLE DESIGN: STEVE RITCHIE" & vbNewline
		me.text = me.text & "SOUNDS AND PROGRAMMING: EUGENE JARVIS" & vbNewline
		me.text = me.text & "RELEASED: MARCH 1980" & vbNewline
		me.text = me.text & "ARTWORK: MITCHELL CONSTANTINO" & vbNewLine
		me.text = me.text & "1.2 Originally VPinMAMEd by Cutter" & vbNewLine
		me.text = me.text & "1.3 thru " & TableVersion & " modifications by greywolf" & vbNewLine
		me.text = me.text & "[feel free to mod - contact greywolf before releasing:]" & vbNewLine
		me.text = me.text & "greywolf@starwolf.com" & vbNewLine & vbNewLine
		me.text = me.text & "[Press 'R' for Rule box]"
End Sub
' This seems to do the trick WRT the stupid solenoid sticking.
' I thought it might be too fast during countdown but it seems to work!
' --*greywolf;

Sub flashfp (enabled)
	dim fstate, pstate
	if (enabled) then
		FFire.state = LightStateBlinking
		FPower.state = LightStateBlinking
		if (flashbackdrop) then
			RFire.SpinReel 1, 2
			RPower.SpinReel 1, 2
		end if
	else
		FFire.state = LightStateOff
		FPower.state = LightStateOff
' Toggle original lights to force redraw.
		fstate = LFire.state AND 1
		pstate = LPower.state AND 1
		LFire.state = not LFire.state
		LPower.state = not LPower.state
		LFire.state = fstate
		LPower.state = pstate
		if (flashbackdrop) then
		end if
	end if
End Sub

Sub Firepower_Credit (enabled)
	flashfp enabled
	vpmSolSound "knocker", enabled
end sub

Sub FirePower_KeyUp(ByVal keycode)
'	if(keycode=RightFlipperKey) then Controller.Switch(45)=FALSE
	If vpmKeyUp(keycode) Then Exit Sub
	If keycode = PlungerKey then
		Plunger.Fire
		if Controller.Switch(46) = true then
			PlaySound "PlungHit"
		else
			PlaySound "PlungerSpring"
		end if
	end if
End Sub

Sub FirePower_KeyDown(ByVal keycode)
'	dtx array(keycode)
'	if(keycode=RightFlipperKey) then Controller.Switch(45)=TRUE
	if keycode = 32 then
		isdebug = not isdebug
	end if
	if keycode = keyRules then
		Show_Rules
	end if
	If vpmKeyDown(keycode) Then Exit Sub
	If keycode = PlungerKey Then Plunger.PullBack
End Sub

Sub Show_Rules()
	Dim rulestxt, rboxstyle, droptxt
	if drop = TRUE then
		droptxt = " drop "
	else
		droptxt = " standing "
	end if
	rboxstyle = vbInformation
	rulestxt = "[vp/vpm " & TableVersion & " by Greywolf, from 1.2 by Cutter]" & vbNewLine & vbNewLine
	rulestxt = rulestxt & "[rulesheet assumes factory settings]" & vbNewLine
	rulestxt = rulestxt & "- Insert coin and wait for machine to reset." & vbNewLine
	rulestxt = rulestxt & "- Making F-I-R-E at top lanes lights ""FIRE"" and advances Bonus Multiplier." & vbNewLine
	rulestxt = rulestxt & "- Making right 3 standing targets lights ""POWER"" and flipper lanes for 3,000, and scores 10,000 points." & vbNewLine
	rulestxt = rulestxt & "- Making ""FIRE"" and ""POWER"" awards FIREPOWER Bonus of 10,000, 30,000 and 50,000 progressively and (eventually) lights outlanes for Speci...um, GOOD THING." & vbNewLine
	rulestxt = rulestxt & "    NOTE:  Top Center Target scores 1,000 points." & vbNewLine
	rulestxt = rulestxt & "- Making center 1-6" & droptxt & "targets lights eject holes for LOCK." & vbNewLine
	rulestxt = rulestxt & "- Locking all balls starts MULTI-BALL[TM]." & vbNewLine
	rulestxt = rulestxt & "- Extra Ball lights at middle ""Power"" target after Bonus Multiplier reaches 5x." & vbNewLine
	rulestxt = rulestxt & vbNewLine & "- GOOD THING scores 1 REPLAY." & vbNewLine
	rulestxt = rulestxt & "- Tilt disqualifies Ball In Play and clears all features for that player." & vbNewLine
	rulestxt = rulestxt & "- Matching last two numbers in score with number in MATCH window scores 1 REPLAY."
	MsgBox	rulestxt, rboxstyle, "FIREPOWER [Williams, 1980]"
end sub
dim whichball
whichball = 0
'Sub Outhole_Hit : bsTrough.AddBall Me : End Sub
'Sub LeftEject_Hit : bsLeft.AddBall Me : End Sub
'Sub RightEject_Hit : bsRight.AddBall Me : End Sub
'Sub UpperEject_Hit : bsUpper.AddBall Me : End Sub

Sub Outhole_Hit
	whichball = whichball mod 3
	if whichball = 0 and randomballs=true then
		bsTrough.ballimage = "blackball"
	else
		bsTrough.ballimage = "proballplain"
	end if
	whichball = whichball + 1
	bsTrough.AddBall Me
end Sub

Sub LeftEject_Hit
	whichball = whichball mod 3
	if whichball = 0 and randomballs=true then
		bsTrough.ballimage = "blackball"
	else
		bsTrough.ballimage = "proballplain"
	end if
	whichball = whichball + 1
	bsLeft.AddBall Me
end Sub

Sub RightEject_Hit
	whichball = whichball mod 3
	if whichball = 0 and randomballs=true then
		bsTrough.ballimage = "blackball"
	else
		bsTrough.ballimage = "proballplain"
	end if
	whichball = whichball + 1
	bsRight.AddBall Me
end Sub

Sub UpperEject_Hit
	whichball = whichball mod 3
	if whichball = 0 and randomballs=true then
		bsTrough.ballimage = "blackball"
	else
		bsTrough.ballimage = "proballplain"
	end if
	whichball = whichball + 1
	bsUpper.AddBall Me
end Sub

Sub spintrig_hit : vpmTimer.PulseSw 15 : End Sub

' This is to work around the 5-times-per-second vpmSpinner routine.
' It seems to sound right
Sub Spinner_spin : Spin.enabled = true : Controller.Switch(15) = true : End Sub
Sub Spin_Timer : me.enabled = false : Controller.Switch(15) = false : End Sub


Sub Bumper1_Hit : vpmTimer.PulseSw 26 : PlaySound "Jet1" : End Sub
Sub Bumper2_Hit : vpmTimer.PulseSw 27 : PlaySound "Jet1" : End Sub
Sub Bumper3_Hit : vpmTimer.PulseSw 25 : PlaySound "Jet1" : End Sub
Sub Bumper4_Hit : vpmTimer.PulseSw 28 : PlaySound "Jet1" : End Sub
' Simulate hitting two targets at once, which VP is unable to simulate
' properly
if drop=false then
	Public Sub TCenter12_Hit : vpmTimer.PulseSw 17 : vpmTimer.pulseSw 18 : End Sub
	Public Sub TCenter23_Hit : vpmTimer.PulseSw 18 : vpmTimer.PulseSw 19 : End Sub
	Public Sub TCenter45_Hit : vpmTimer.PulseSw 21 : vpmTimer.PulseSw 22 : End Sub
	Public Sub TCenter56_Hit : vpmTimer.PulseSw 22 : vpmTimer.PulseSw 23 : End Sub
end if
Sub TPower12_Hit : vpmTimer.PulseSw 39 : vpmTimer.PulseSw 40 : End Sub
Sub TPower23_Hit : vpmTimer.PulseSw 40 : vpmTimer.PulseSw 41 : End Sub
Sub LeftSlingshot_Slingshot : vpmTimer.PulseSw 12 : PlaySound "slingshot" : End Sub
Sub RightSlingshot_Slingshot : vpmTimer.PulseSw 42 : PlaySound "slingshot" : End Sub

Sub sw46_Hit : Controller.Switch(46)=TRUE : End Sub
Sub sw46a_UnHit : Controller.Switch(46)=FALSE : End Sub

'li54 -> LMatch
'li55 -> LBall
'li56 ->
'li61 -> LTilt
'li62 -> LGameOver
'li63 -> LSPSA
'li64 -> LHighScore
'
' Screwy logic:
' If GAME OVER and FIRE AGAIN are lit, the game is NOT over.
' *** this logic has been replaced with the solCallBack(23).
' *** many thanks to wpcmame for his invaluable assistance!
'
Sub UpdateMultipleLamps()
	if(LTilt.state=LightStateOn) then
		XTilt.text="TILT"
	else
		XTilt.text=""
	end if
'	dtx(array(bumper1.disabled, bumper2.disabled, bumper3.disabled, bumper4.disabled, leftslingshot.disabled,rightslingshot.disabled))

	if(LMatch.state=LightStateOn) then
		XMatch.text="MATCH"
	else
		XMatch.text=""
	end if
	if(LBall.state=LightStateOn) then
		XBall.text = "BALL IN" & vbNewLine & "     PLAY"
	else
		XBall.text = ""
	end if
	if(LGameOver.state=LightStateOn) then
		XGameOver.text="GAME OVER"
	else
		XGameOver.text=""
	end if
	if(LSPSA.state=LightStateOn) then
		XSPSA.text="FIRE AGAIN!!"
	else
		XSPSA.text=""
	end if
	if(LHighScore.state=LightStateOn) then
		XHighScore.text="HIGHEST SCORE"
	else
		XHighScore.text=""
	end if
End Sub

Const sOutHole      =  1
Const sResetBank1   =  2
Const sResetBank2   =  3
Const sLeftEject    =  4
Const sRightEject   =  5
Const sUpperEject   =  6
Const sKickBack     =  7
Const sBallRelease  =  8
Const sKnocker      = 14
Const sFlasher      = 15
Const sLSling       = 22
Const sRSling       = 21
Const sBumper1      = 17
Const sBumper4      = 18
Const sBumper2      = 19
Const sBumper3      = 20
Const sTableRelay	= 23

Sub dtx (stuff)
	dim i
	dim msg
	if (not isdebug) then
		Xdt.text = ""
		exit sub
	end if

	for each i in stuff
		msg = msg & i & ","
	next
	Xdt.text = msg
end sub

' Code suggested to me by WPCmame -- THANK YOU!
Dim fpOptions
Private Sub fpShowDips
	If Not IsObject(vpmDips) Then ' First time
		Set vpmDips = New cvpmDips
		With vpmDips
			.AddForm  80, 290, "DIP switches [requires reload]"
			.AddFrame  0,0, 60,"Sound", 0,_
			  Array("DIP 1",&H000000001,"DIP 2",&H00000002)
			.AddFrame  0,45, 60,"Game", 0,_
			  Array("DIP  1",&H00000100,"DIP  2",&H00000200,"DIP  3",&H00000400,"DIP  4",&H00000800,_
			        "DIP  5",&H00001000,"DIP  6",&H00002000,"DIP  7",&H00004000,"DIP  8",32768,_
			        "DIP  9",&H00010000,"DIP 10",&H00020000,"DIP 11",&H00040000,"DIP 12",&H00080000,_
			        "DIP 13",&H00100000,"DIP 14",&H00200000,"DIP 15",&H00400000,"DIP 16",&H00800000)
			.AddFrameExtra 80,0,100,"Game Settings",0,_
			  Array("Drop targets",&H01,"Black Ball",&H02,"Flash Backdrop",&H04)
		End With
	End If
	fpOptions = vpmDips.ViewDipsExtra(fpOptions)
	SaveValue "Frpwr_l2","Options",fpOptions
End Sub
Set vpmShowDips = GetRef("fpShowDips")
Function fpLoadBallHelp(aName,aBalls)
	Dim tmp : tmp = CInt("0" & LoadValue("frpwr_l2",aName))
	If tmp > aBalls Then tmp = aBalls : aBalls = 0 Else aBalls = aBalls - tmp
	fpLoadBallHelp = tmp
End Function
Sub fpLoadBalls
	Dim balls : balls = 3
	bsUpper.Balls = fpLoadBallHelp("Upper",balls)
	bsLeft.Balls  = fpLoadBallHelp("Left", balls)
	bsRight.Balls = fpLoadBallHelp("Right",balls)
	bsTrough.Balls = balls
End Sub
Sub fpSaveBalls
	SaveValue "frpwr_l2","Left",  bsLeft.balls
	SaveValue "frpwr_l2","Right", bsRight.balls
	SaveValue "frpwr_l2","Upper", bsUpper.balls
End Sub
Sub FirePower_Exit
	fpSaveBalls
End Sub