131 replies to this topic

[scutters]

Haunted Hotel (LTD do Brasil)

 

4*7 & 2*1 numeric 7 segment display to flexDMD conversion for weisshunds vpx  table

 

Not going to paste the same old code blocks again but for ref the dictionary lookup is different for this rom, numbers 0-8 match the one i used for Aliens (Williams sorcerer rom) but was different for 9 and can also display an A. Dictionary lookup mapping block for this table looks like;

Sub FlexDictionary_Init

	'add conversion of segment charcters codes to lookup table
	Set FlexDMDDict = CreateObject("Scripting.Dictionary")

	FlexDMDDict.Add 0, " "
	FlexDMDDict.Add 63, "0"
	FlexDMDDict.Add 6, "1"
	FlexDMDDict.Add 91, "2"
	FlexDMDDict.Add 79, "3"
	FlexDMDDict.Add 102, "4"
	FlexDMDDict.Add 109, "5"
	FlexDMDDict.Add 125, "6"
	FlexDMDDict.Add 7, "7"
	FlexDMDDict.Add 127, "8"
	FlexDMDDict.Add 103, "9"
	
	FlexDMDDict.Add 119, "A"
	 
End Sub

Might be reusable for roms of same type. For full code check the table code from the download link.

 

Result looks like this (default freezy / external dmd display on top and flex conversion at bottom);

 

Edited by scutters, 03 November 2021 - 10:10 AM.

[wiesshund]

Haunted Hotel (LTD do Brasil)

Might be reusable for roms of same type. For full code check the table code from the download link.

 

 

Pecmen is the only other LTD table that uses this particular controller, though the dictionary may be applicable
to maybe an LTD system 4 or 3? i will have to try it for giggles and see maybe

As you can see in freezys though, this controller represents it self odd, as far as freezy's sees it
The others do not

[scutters]

Dantes Inferno Conversion

 

Table is a reskin using Peypers Nemesis rom. Nice and simple numeric only segment display. Lookup / dictionary for segment code mapping for this table is;

Sub FlexDictionary_Init

	'add conversion of segment charcters codes to lookup table
	Set FlexDMDDict = CreateObject("Scripting.Dictionary")

	FlexDMDDict.Add 0, " "
	FlexDMDDict.Add 63, "0"
	FlexDMDDict.Add 6, "1"
	FlexDMDDict.Add 91, "2"
	FlexDMDDict.Add 79, "3"
	FlexDMDDict.Add 102, "4"
	FlexDMDDict.Add 109, "5"
	FlexDMDDict.Add 125, "6"
	FlexDMDDict.Add 7, "7"
	FlexDMDDict.Add 127, "8"
	FlexDMDDict.Add 111, "9"

End Sub

Might be reusable for roms of same type. For full code check the table code from the download link.

 

 

Result looks like this (default freezy / external dmd display on top and flex conversion at bottom);

 

 

Script etc - here

Edited by scutters, 30 April 2022 - 10:00 AM.

[Mrtr32]

Excellent idea!

 

The result is awesome!

 

I think this conversion feature must be part of FlexDMD directly.

 

Perhaps Vincent Bousquet can add the conversion feature in the future FlexDMD release.

 

Thanks!

Edited by Mrtr32, 12 March 2022 - 09:56 PM.

[scutters]

A few more backglass segment score display tables now have flex support built in (so more examples for any future conversions, code used is just variants of that in previous posts so not reposting all of that);

 

Recreations (so mainly done for real dmd users or 3 screen virtual users where there is no 3scr b2s, but the dmd should work on any setup where flex is installed. Could also be useful for table reskin mods)

 

Robocop https://www.vpforums...&showfile=15421 - Type DataEast/Sega Version 2

Back To The Future https://www.vpforums...&showfile=14338 - Type DataEast/Sega Version 3

Robo-War https://www.vpforums...&showfile=15260 - Type system 80B

Victory https://vpuniverse.c...-gottlieb-1987/  - Type system 80B

Firepower https://www.vpforums...&showfile=16947 - Williams system 6

Excalibur https://www.vpforums...&showfile=15121 - system 80B

Operation Thunder https://www.vpforums...&showfile=14735 - Gottlieb system 3

Roller Games https://vpuniverse.c...drakkon-mod-11/ - Williams system 11C

Six Million Dollar Man https://www.vpforums...&showfile=14291 - Bally AS-2518-35

Firepower II https://www.vpforums...&showfile=17049 - Williams system 7

 

 

Mod

 

Gremlins https://vpuniverse.c...ns-by-balutito/ - Mod uses victory rom so type 80B

 

 

Enable the flex dmd for these tables using the UseFlexDMD option in the table script.

Thanks to the authors for including the code with the official table releases and Mike Da Spike for work on Robo-War and Victory (and a lot of testing!.

Edited by scutters, 27 January 2023 - 09:48 PM.

[wiesshund]

You do any wide displays yet Scutters?

[scutters]

You do any wide displays yet Scutters?

 

Lol no, no 512*32 ultra wide flex dmd's yet. You know me, just trying to keep the real dmd crowd off my back 

[wiesshund]

 

You do any wide displays yet Scutters?

 

Lol no, no 512*32 ultra wide flex dmd's yet. You know me, just trying to keep the real dmd crowd off my back 

 

 

You should do one, just for your own giggles

 

Actually, would be cool for an original vintage style table too
or one from that era that we dont have a working ROM for

 

Yea DMD's are great, but there was a cool factor to having words and stuff go scrolling across a 30 character display

[Citron68]

Hi, (sorry for my bad english I'm French people)

 

It's my 1st message in VPforum, and I don't pretend to know how to program on VPX (I just run the tables on my pincab and enjoy the work of all the "GODS" of the flip that you are).

 

On the other hand, in my Top10, I have the GENESIS table and I had some time ago opened a topic to display the DMD on the Pin 2 DMD on another French forum and I had been answered that it was not possible with this table.
Afterwards, I had left aside playing with the scores on the backglass.
Then with the DOF version, I had the score displayed on the Pin 2 DMD (but it is cut)...

While browsing the forum, I saw a topic that talked about FlexDMD and that scutter had managed to do the scores on the Logan's run VPX table.
Running that table, I saw that this is what I would like to apply to the Genesis DMD.
The rom system seems to be the same (sys80.vbs)

I try to copy the script part of Logan's run concerning the FlexDMD part in the Genesis script...
And.... doesn't work ???
 
I'm not competent enough, so I'm asking you to help me to understand what I didn't do well (if it's still understandable).

I put you a copy of the script that I modified:

'Genesis - Gottlieb 1986
'VP912 table by jpsalas
'3D VP10 conversion by nFozzy 

'Version 1.11

'DOF additions by arngrim

Option Explicit
Randomize

On Error Resume Next
ExecuteGlobal GetTextFile("controller.vbs")
If Err Then MsgBox "You need the controller.vbs in order to run this table, available in the vp10 package"
On Error Goto 0

Dim UseVPMDMD
Dim DesktopMode:DesktopMode = Genesis.ShowDT

If DesktopMode = True Then 'Show Desktop components
Ramp10.visible = 1
Ramp5.visible = 1
Ramp37.visible = 1
Ramp38.visible = 1
Prim_Sidewalls.visible=1
Else
Ramp10.visible = 0
Ramp5.visible = 0
Ramp37.visible = 0
Ramp38.visible = 0
Prim_Sidewalls.visible=0
End if

UseVPMDMD = 1


dim fullscreendisplay
''===================
'\\\\\\\\\\\\\\\\\\\\\
'fullscreen display options
'2 = fullscreen display (best for single screen setups)
'1 = movable pinmame DMD window
'0 = No fullscreen display (use B2S instead)

fullscreendisplay = 0

'/////////////////////
'====================

dim Dropfix

'Set this to 1 if you are using VP10 1.0 and the drop targets aren't resetting properly
Dropfix = 0



 'setup display
dim xx
If DesktopMode then
	For each xx in Display:xx.X = xx.X - 150: xx.Y = xx.Y - 400: xx.rotX = -55: xx.height = xx.height + 320: Next
	For each xx in Display2:xx.Y = xx.y - 20: xx.X = xx.X - 6: xx.height = xx.height - 30: Next
end if


'Load VPM and scripts

LoadVPM "01560000", "sys80.vbs", 3.36

'Ajout info FlexDMD
Const UseFlexDMD = 1	' 1 is on. Most useful for real dmd users (also turn off use external dmd in vpinmame)
'

Const cGameName = "genesis"
Const UseSolenoids = 1
Const UseLamps = 0

'Standard sounds
Const SSolenoidOn = "Solenoid"    'Solenoid activates
Const SSolenoidOff = ""           'Solenoid deactivates
Const SCoin = "Coin"              'Coin inserted

Dim bsTrough, bsArmsLock, bsLegsLock, dtM', plungerIM
Dim x, Balls', bump1, bump2, bump3, bump4
Dim Last12, Current12, Last13, Current13, Last14, Current14

Set MotorCallback = GetRef("RollingUpdate") 'realtime updates - rolling sound

'**********
'Table Init
'**********

Sub Genesis_Init
	vpmInit Me

	With Controller
		.GameName = cGameName
		If Err Then MsgBox "Can't start Game" & cGameName & vbNewLine & Err.Description:Exit Sub
		.SplashInfoLine = "Genesis (Gottlieb 1986)" & vbNewLine & "VP9 table by JPSalas"
'		.Games(cGameName).Settings.Value("dmd_red") = 0
'		.Games(cGameName).Settings.Value("dmd_green") = 128
'		.Games(cGameName).Settings.Value("dmd_blue") = 255
'		.Games(cGameName).Settings.Value("rol") = 0
		.HandleKeyboard = 0
		.ShowTitle = 0
		.ShowDMDOnly = 1
		.ShowFrame = 0
		.HandleMechanics = 0
		.Hidden = 1
		'.SetDisplayPosition 0,0,GetPlayerHWnd 'if you can't see the DMD then uncomment this line
		On Error Resume Next
		Controller.SolMask(0) = 0
		vpmTimer.AddTimer 2000, "Controller.SolMask(0)=&Hffffffff'" 'ignore all solenoids - then add the timer to renable all the solenoids after 2 seconds
		Controller.Run GetPlayerHwnd
		If Err Then MsgBox Err.Description
		On Error Goto 0
	End With

	' Nudging
	vpmNudge.TiltSwitch = 57 'swTilt
	vpmNudge.Sensitivity = 5
	vpmNudge.TiltObj = Array(Bumper1, Bumper2, Bumper3, Bumper4, LeftSlingshot, RightSlingshot)

	'Saucers Declaration
	Set bsArmsLock = New cvpmSaucer
	with bsArmsLock
		.InitKicker Armslock, 43, 185, 8, 8	' LeftKickout '160, 5 ,8
		.InitExitVariance 1, 0
		.InitSounds "kicker_enter", SoundFX("Solenoid",DOFContactors), SoundFX("Popper",DOFContactors)
		.createevents "bsArmsLock", Armslock
	end with

	Set bsLegsLock = New cvpmSaucer
	with bsLegsLock
		.InitKicker Legslock, 73, 346, 18, 8	' RightKickout '320, 16, 20
		.InitExitVariance 2, 2
		.InitSounds "kicker_enter", SoundFX("Solenoid",DOFContactors), SoundFX("Popper",DOFContactors)
		.createevents "bsLegsLock", LegsLock
	end with


	Set dtM = New cvpmDropTarget
	dtM.InitDrop Array(dt1, dt2, dt3), Array(41, 51, 61)
	dtM.InitSnd SoundFX("droptarget",DOFContactors), SoundFX("resetdrop",DOFContactors)
	dtM.CreateEvents "dtM"


	'Trough Declaration
	Set bsTrough = New cvpmBallStack
	bsTrough.InitSw 55, 0, 74, 0, 0, 0, 0, 0
	bsTrough.InitKick Ballrelease, 80, 6
	bsTrough.InitExitSnd SoundFX("ballrel",DOFContactors), SoundFX("Solenoid",DOFContactors)
	bsTrough.Balls = 2

    ' New style Trough that didn't quite work out
'    Set bsTrough = New cvpmTrough
'    With bsTrough
'        .size = 2
'        .initSwitches Array(55, 74)
'        .Initexit BallRelease, 80, 6
'        .InitEntrySounds "drain", "Solenoid", "Solenoid"
'        .InitExitSounds "Solenoid", "ballrel"
'        .Balls = 2
'    End With

	'Init Target Walls animation
	RightKick.IsDropped = 1:LeftKick.IsDropped = 1
	RightKick2.IsDropped = 0:LeftKick2.IsDropped = 0

	'Init Robot Lights
	StopRobotLights

	'Other variables
	Last12 = 0
	Current12 = 0
	Last13 = 0
	Current13 = 0
	Last14 = 0
	Current14 = 0

	PinMAMETimer.Interval = PinMAMEInterval
	PinMAMETimer.Enabled = 1
	'StartShake

	SolGI 0:SolLeft 0:SolRight 0

	'display Option
	if not DesktopMode and fullscreendisplay <> 2 then
	For each xx in Display:xx.visible = 0: Next
	Displaytimer.enabled = 0
	end If

	' initalise the FlexDMD display
    If UseFlexDMD Then FlexDMD_Init
 
End Sub

Sub Genesis_Paused:Controller.Pause = 1:End Sub
Sub Genesis_unPaused:Controller.Pause = 0:End Sub

' keys

Sub Genesis_KeyDown(ByVal keycode)
	If keycode = PlungerKey Then Plunger.Pullback
	If keycode = LeftTiltKey Then PlaySound SoundFX("nudge_left",0)
	If keycode = RightTiltKey Then PlaySound SoundFX("nudge_right",0)
	If keycode = CenterTiltKey Then PlaySound SoundFX("nudge_forward",0)
	If vpmKeyDown(keycode) Then Exit Sub
	If keycode = KeyRules Then Rules
	If keycode=31 then 'test debug
'	kicker1.createball
'	kicker1.kick -10, 35
		'l13.state=1
'	gi1.state = 0
'	Rubber_Straightb10.size_x = 85
'	Rubber_Straightb8.size_x = 85
'	Rubber_Straightb14.size_x = 85
'	rubberanim.enabled = 1
	End If
End Sub


Sub Genesis_KeyUp(ByVal keycode)
	If keycode = PlungerKey Then
		Plunger.Fire
		If(BallinPlunger = 1) then 'the ball is in the plunger lane
			PlaySound "Plunger2"
		else
			PlaySound "Plunger"
		end if
	End If
'	If keycode = LeftTiltKey Then PlaySound "nudge_left"
	If vpmKeyUp(KeyCode) Then Exit Sub
'	If keycode=31 then 'light test
'		l13.state=0
'	End If
End Sub

'***********************
'JP's Alpha Ramp Plunger
'***********************
Dim BallinPlunger

Sub swPlunger_Hit:BallinPlunger = 1:End Sub                            'in this sub you may add a switch, for example Controller.Switch(14) = 1

Sub swPlunger_UnHit:BallinPlunger = 0:End Sub                          'in this sub you may add a switch, for example Controller.Switch(14) = 0


'*******************
'Solenoids Callback
'*******************

'SolCallback(1) = "" 'Varitarget ??
SolCallback(2) = "bsLegsLock.SolOut"
SolCallback(4) = "SolLeft"
SolCallback(5) = "bsArmsLock.SolOut"
SolCallback(6) = "DropDelaysub"
'SolCallback(6) = "dtM.SolDropUp"
SolCallback(7) = "SolRight"
SolCallback(8) = "vpmSolSound SoundFX(""Knocker"",DOFKnocker),"
'SolCallback(8) = "VpmSolSound""knocker"","
SolCallback(9) = "SolOuthole"
SolCallback(10) = "SolGI"

'dim Drop targets 
dim drop1, drop2, drop3
drop1 = dt1.isdropped
drop2 = dt2.isdropped
drop3 = dt3.isdropped



'Drop Delay
Sub DropDelaysub(enabled)
	If Dropfix = 1 then
		DropDelay.Enabled = 1
	Else
		dtM.DropSol_On
		drop1 = 0
		drop2 = 0
		drop3 = 0
		updateGI
	End If
End Sub

Sub DropDelay_Timer()
	dtM.DropSol_On
	me.interval = 20
	me.enabled = 0
	drop1 = 0
	drop2 = 0
	drop3 = 0
	updateGI
End Sub

'Solenoids Subs

Sub SolGI(Enabled)
	If Enabled Then
'	textbox1.text = Enabled
		gi1.state=1:gi2.state=1:gi3.state=1:gi4.state=1:gi5.state=1:gi6.state=1:gi7.state=1:gi8.state=1:gi9.state=1:gi10.state=1:gi11.state=1:gi12.state=1:gi13.state=1:gi_ambient.state=1:gi15.state=1
		UpdateGi
	Else
'	textbox1.text = Enabled
		gi1.state=0:gi2.state=0:gi3.state=0:gi4.state=0:gi5.state=0:gi6.state=0:gi7.state=0:gi8.state=0:gi9.state=0:gi10.state=0:gi11.state=0:gi12.state=0:gi13.state=0:gi_ambient.state=0:gi15.state=0
		UpdateGi
	End If
End Sub

Sub UpdateGI
gi14.state = gi7.state
if drop1 = 1 then gi14_1.state = gi7.state else gi14_1.state = 0 end if
if drop2 = 1 then gi14_2.state = gi7.state else gi14_2.state = 0 end if
if drop3 = 1 then gi14_3.state = gi7.state else gi14_3.state = 0 end if

end sub


'Sub timer1_timer() 'check DTs Debug
'textbox4.text = dt1.isdropped & " " & dt2.isdropped & " " & dt3.isdropped
'textbox5.text = drop1 & " " & drop2 & " " & drop3
'updategi

'End Sub

Sub SolLeft(Enabled) 
	If Enabled Then
		Fl2.state = 2:fl3.state = 2:playsound "lswitch", 0, 0.01, 0, 0.1
'		textbox1.text = "ON"
	Else
		Fl2.state=0:fl3.state=0
'		textbox1.text = "OFF"
	End If
End Sub



Sub SolRight(Enabled)
	If Enabled Then
		fr2.state = 2
		fr3.State = 2
		playsound "lswitch", 0, 0.001, 0
'		textbox2.text = "ON"
	Else
		fr2.state = 0
		fr3.State = 0
'		textbox2.text = "OFF"
	End If
End Sub

Sub SolOuthole(enabled)
	if enabled then
		bsTrough.EntrySol_On
'		bsTrough.ExitSol_On
	end if
End Sub

'*************
'Robots Lights
'*************

Dim RobotLightStep, RobotLightsOn, EndIt

RobotLightStep = 0:RobotLightsOn = 0

Sub StartRobotLights
'	If Robotlightson=1 then
'		Exit Sub
'	End If
'	'light2.state=1
'	RobotLightStep = 0
'    RobotLightsOn = 1
'	RobotLights.Enabled = 1
	ll1.state=2:rl1.state=2:ll2.state=2:rl2.state=2:ll3.state=2:rl3.state=2:ll4.state=2:rl4.state=2:ll5.state=2:rl5.state=2
	cl1.state = 2: cl2.state = 2: cl3.state = 2: cl4.state = 2: cl5.state = 2
End Sub

'Sub maybestoprobotlights	' I think this prevents the lightshow from ending early during the robot reveal sequence
'	If CurrentRot=0 then LightSeqTimer.Enabled=1 End If	'lightseqtimer judges if the lights should be on or not..
'	If CurrentRot<0 then 
'	StopRobotLights 
'	End If
'end Sub

'the way I scripted this makes my head hurt
	
Sub StopRobotLights
'	RobotLightStep=65
	'light2.state=0
	ll1.state=0:rl1.state=0:ll2.state=0:rl2.state=0:ll3.state=0:rl3.state=0:ll4.state=0:rl4.state=0:ll5.state=0:rl5.state=0
	cl1.state = 0: cl2.state = 0: cl3.state = 0: cl4.state = 0: cl5.state = 0
'    RobotLightsOn = 0
End Sub

'Sub RobotLights_Timer	'replaced by blink pattern 'interval was 70
'	Select Case RobotLightStep
'		Case 0:Ll1.State=1:Rl1.state=1
'		Case 1:Ll2.state=1:Rl2.state=1
'		Case 2:ll1.state=0:rl1.state=0:ll3.state=1:rl3.state=1
'		Case 3:ll2.state=0:rl2.state=0:ll4.state=1:rl4.state=1
'		Case 4:ll3.state=0:rl3.state=0:ll5.state=1:rl5.state=1
'		Case 5:ll4.state=0:rl4.state=0
'		Case 6:ll5.state=0:rl5.state=0
'		Case 66:ll1.state=0:rl1.state=0:ll2.state=0:rl2.state=0:ll3.state=0:rl3.state=0:ll4.state=0:rl4.state=0:ll5.state=0:rl5.state=0
'		Case 67:RobotLights.Enabled=0:RobotLightStep=1
'	End Select
'	RobotLightStep = RobotLightStep + 1
'	If RobotLightStep = 7 Then RobotLightStep = 0
'End Sub

'****************
' Robot Animation

'****************
dim StartRotation
dim EndRotation
Dim CurrentRot

StartRotation=0
EndRotation=-360

Sub StartRobotAnimation
	CurrentRot=0
	'Light1.State=1 'Light1 + Light 2 are additional ambient lighting
	SpinTimer.Enabled=1
End Sub

Sub SpinTimer_Timer()
	If Currentrot=EndRotation then 
		currentrot=StartRotation 'back to 0
		me.Enabled=0
		'Light1.State=0
		Exit Sub
	End If
	'If CurrentRot< -180 then Light1.State=0 End If
	If currentrot> EndRotation then currentrot=currentrot-0.28 End If
	Goldy.roty=CurrentRot
	Goldy2.roty=CurrentRot
End Sub

'**************
' Flipper Subs
'**************

SolCallback(sLRFlipper) = "SolRFlipper"
SolCallback(sLLFlipper) = "SolLFlipper"

Sub SolLFlipper(Enabled)
	Controller.Switch(75) = ABS(enabled)
	If Enabled Then
		'PlaySound "flipperup":LeftFlipper.RotateToEnd
		LeftFlipper.RotateToEnd
		If LeftFlipper.CurrentAngle<80 Then		'If weak flip...
		PlaySound SoundFx("FlipperUp",DOFContactors),0,0.1,-0.05		'Play a Weaker Flip Sound
		Else PlaySound SoundFx("FlipperUp",DOFContactors),0,1,-0.05
		End If
	Else
		PlaySound SoundFx("Flipperdown",DOFContactors),0,0.05,-0.02:LeftFlipper.RotateToStart
	End If
End Sub

Sub SolRFlipper(Enabled)
	Controller.Switch(75) = ABS(enabled)
	If Enabled Then
		'PlaySound "flipperup":RightFlipper.RotateToEnd
		RightFlipper.RotateToEnd
		If RightFlipper.CurrentAngle > (80*-1) Then	'If weak flip... 
		PlaySound SoundFx("FlipperUp",DOFContactors),0,0.1,0.05			'Play a Weaker Flip Sound
		Else PlaySound SoundFx("FlipperUp",DOFContactors),0,1,0.05
		End If
	Else
		PlaySound SoundFx("Flipperdown",DOFContactors),0,0.05,0.02:RightFlipper.RotateToStart
	End If
End Sub

'SoundFx("Flipperdown",DOFContactors),

Sub LeftFlipper_Collide(parm)
	PlaySound "rubber_flipper"
End Sub

Sub RightFlipper_Collide(parm)
	PlaySound "rubber_flipper"
End Sub

'Set MotorCallback = GetRef("RealTimeUpdates")

Sub FlipperTimer_Timer()
	UpdateLeftFlipperLogo
	UpdateRightFlipperLogo
End Sub

Sub UpdateLeftFlipperLogo()
	LFLogo.RotY = LeftFlipper.CurrentAngle
End Sub
Sub UpdateRightFlipperLogo()
	RFLogo.RotY = RightFlipper.CurrentAngle
End Sub


'************
'Varitarget
'omg
'************

'Varitarget primitive version:
'range: all the way forward rotX -9 & -128
'all the way back rotx 12 & -20
dim variball

dim Y 'variangle
dim CFA 'FlipperAngle
CFA = Flipper2.currentangle

Y = -9

sub Invari_hit()
	me.timerenabled = 0
	me.timerinterval = 500
	VariChecker.enabled = 1
end sub

sub Invari_unhit()
	me.timerinterval = 500
	me.timerenabled = 1
'	VariChecker.enabled = 0

end sub

sub invari_timer()
	if y < -8.5 then varichecker.enabled = 0: me.timerenabled = 0 end if
end sub


'sub 	set variball = BallcntOver
Sub Varichecker_timer()
	CFA = Flipper2.currentangle
	y = ((7 * CFA) / 36) + (143 / 9)
	Varitarget.rotX = Y
'	textbox2.text = Y
'	textbox3.text = flipper2.currentangle & flipper2.startangle & flipper2.endangle


'I am bad at maths


End sub

dim v1, v2, v3, v4
v1 = 0:v2 = 0:v3=0:v4=0
'Varitimer is 200ms

Sub Varitarget1_Hit
	If ActiveBall.VelY <0 Then
		Controller.Switch(40) = 1
		V1 = 1
		V2 = 0
	end if
End Sub

Sub Varitarget1_UnHit
	If ActiveBall.VelY> 0 Then VariTimer.Enabled = 1
End Sub


Sub Varitarget2_Hit
	If ActiveBall.VelY <0 Then
		Controller.Switch(50) = 1
		V2 = 1
		V3 = 0
	end if
End Sub

Sub Varitarget3_Hit
	If ActiveBall.VelY <0 Then
		Controller.Switch(60) = 1
		V3 = 1
		V4 = 0
	end if
End Sub

Sub Varitarget4_Hit
	Controller.Switch(70) = 1
End Sub

Sub VariTimer_Timer
	If v4 = 0 Then
		Controller.Switch(70) = 0
		V4 = 1
		V3 = 0
		Exit Sub
	End If

	If v3 = 0 Then
		Controller.Switch(60) = 0
		V3 = 1
		V2 = 0
		Exit Sub
	End If

	If v2 = 0 Then
		Controller.Switch(50) = 0
		V2 = 1
		V1 = 0
		Exit Sub
	End If

	Controller.Switch(40) = 0
	VariTimer.Enabled = 0
End Sub


'Triggers

Sub LeftKick_Timer:LeftKick.TimerEnabled = 0:LeftKick2.IsDropped = 0:LeftKick.IsDropped = 1:End Sub

Sub LeftKick2_Slingshot():vpmTimer.PulseSw(45):LeftKick.IsDropped = 0:LeftKick2.IsDropped = 1:LeftKick.TimerEnabled = 1:PlaySound SoundFx("slingshot",DOFContactors),0, 0.8, -0.08, 0.05:End Sub 'PlaySound "name",loopcount,volume,pan,randompitch

Sub RightKick_Timer:RightKick.TimerEnabled = 0:RightKick2.IsDropped = 0:RightKick.IsDropped = 1:End Sub

Sub RightKick2_Slingshot():vpmTimer.PulseSw(65):RightKick.IsDropped = 0:RightKick2.IsDropped = 1:RightKick.TimerEnabled = 1:PlaySound SoundFx("slingshot",DOFContactors),0, 0.8, 0.08, 0.05:End Sub 'PlaySound "name",loopcount,volume,pan,randompitch

Sub LeftLane_Hit():Playsound "sensor":Controller.switch(53) = 1:End Sub
Sub LeftLane_UnHit():Controller.switch(53) = 0:End Sub


Sub Spinner_Spin():Playsound "spinner":End Sub

Sub Toplane1_Hit():Playsound "sensor":Controller.switch(42) = 1:End Sub
Sub Toplane1_UnHit():Controller.switch(42) = 0:End Sub
Sub Toplane2_Hit():Playsound "sensor":Controller.switch(52) = 1:End Sub
Sub Toplane2_UnHit():Controller.switch(52) = 0:End Sub
Sub Toplane3_Hit():Playsound "sensor":Controller.switch(62) = 1:End Sub
Sub Toplane3_UnHit():Controller.switch(62) = 0:End Sub

Sub LeftInLane_Hit():Playsound "sensor":Controller.switch(44) = 1:DOF 101, DOFOn:End Sub
Sub LeftInLane_UnHit():Controller.switch(44) = 0:DOF 101, DOFOff:End Sub
Sub LeftOutlane_Hit():Playsound "sensor":Controller.switch(54) = 1:End Sub
Sub LeftOutlane_UnHit():Controller.switch(54) = 0:End Sub
Sub RightInlane_Hit():Playsound "sensor":Controller.switch(44) = 1:DOF 102, DOFOn:End Sub
Sub RightInlane_UnHit():Controller.switch(44) = 0:DOF 102, DOFOff:End Sub
Sub RightOutlane_Hit():Playsound "sensor":Controller.switch(64) = 1:End Sub
Sub RightOutlane_UnHit():Controller.switch(64) = 0:End Sub

'One Way Switch
Dim TopDown
TopDown=False

Sub OneWaySwitch_Hit()
	OneWayTimer.Enabled=1
	TopDown=True
End Sub

Sub OneWayTimer_Timer()
	TopDown=False
	OneWayTimer.Enabled=0
End Sub

Sub sw63_Hit()
	If TopDown=False then Controller.switch(63) = 1':playsound "Diverter"
End Sub

Sub sw63_UnHit() 'extra switch juice
	me.timerenabled=1
End Sub

Sub sw63_Timer() 'extra switch juice
	Controller.switch(63) = 0
	me.Timerenabled=0
End Sub

'Drop-Targets
Sub dt1_hit():dtM.Hit 1:End Sub
Sub dt1_dropped():drop1 = 1:updategi:End Sub

Sub dt2_hit():dtM.Hit 2:End Sub
Sub dt2_dropped():drop2 = 1:updategi:End Sub

Sub dt3_hit():dtM.Hit 3:End Sub
Sub dt3_dropped():drop3 = 1:updategi:End Sub


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

Sub LeftSlingShot_Slingshot
	vpmTimer.PulseSw(72)
    PlaySound SoundFXDOF("slingshot",112,DOFPulse,DOFContactors),0,1,-0.05,0.05
    LSling.Visible = 0
    LSling1.Visible = 1
    sling2.TransZ = -42
    LStep = 0
    LeftSlingShot.TimerEnabled = 1
End Sub

Sub LeftSlingShot_Timer
    Select Case LStep
        Case 3:LSLing1.Visible = 0:LSLing2.Visible = 1:sling2.TransZ = -25
        Case 4:LSLing2.Visible = 0:LSLing.Visible = 1:sling2.TransZ = 0:LeftSlingShot.TimerEnabled = 0':gi3.State = 1:Gi4.State = 1
    End Select
    LStep = LStep + 1
End Sub

'Right Slingshot

Sub RightSlingShot_Slingshot
	vpmTimer.PulseSw(72)
    PlaySound SoundFXDOF("slingshot",113,DOFPulse,DOFContactors), 0, 1, 0.05, 0.05
    RSling.Visible = 0
    RSling1.Visible = 1
    sling1.TransZ = -42
    RStep = 0
    RightSlingShot.TimerEnabled = 1
End Sub

Sub RightSlingShot_Timer
    Select Case RStep
        Case 3:RSLing1.Visible = 0:RSLing2.Visible = 1:sling1.TransZ = -25
        Case 4:RSLing2.Visible = 0:RSLing.Visible = 1:sling1.TransZ = 0:RightSlingShot.TimerEnabled = 0':gi1.State = 1:Gi2.State = 1
    End Select
    RStep = RStep + 1
End Sub

'-==============================

'Bumpers
'Sub Bumper1_Hit():vpmTimer.PulseSw(71):PlaySound "bumper1":End Sub
'
'Sub Bumper2_Hit():vpmTimer.PulseSw(71):PlaySound "bumper2":End Sub
'
'Sub Bumper3_Hit():vpmTimer.PulseSw(71):PlaySound "bumper3":End Sub
'
'Sub Bumper4_Hit():vpmTimer.PulseSw(71):PlaySound "bumper2":End Sub
'

Sub Bumper1_Hit()
vpmTimer.PulseSw(71)
PlaySound SoundFXDOF("Bumper1",103,DOFPulse,DOFContactors)
dim finalspeed
finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
'textbox1.text = finalspeed
If finalspeed > 13.5 and gi7.state = 1 then gi1.state = 2 end if 
'If gi7.state = 1 then gi1.state = 2 end if
me.timerenabled = 1
End Sub

Sub Bumper1_Timer()
gi1.state = gi7.state
me.timerenabled = 0
end sub

Sub Bumper2_Hit()
vpmTimer.PulseSw(71)
PlaySound SoundFXDOF("Bumper2",104,DOFPulse,DOFContactors)
End Sub

Sub Bumper3_Hit()
vpmTimer.PulseSw(71)
PlaySound SoundFXDOF("Bumper2",105,DOFPulse,DOFContactors)
dim finalspeed
finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
If finalspeed > 13.5 and gi7.state = 1 then gi3.state = 2 end if 
'If gi7.state = 1 then gi3.state = 2 end if
me.timerenabled = 1
End Sub

Sub Bumper3_Timer()
gi3.state = gi7.state
me.timerenabled = 0
end sub

Sub Bumper4_Hit()
vpmTimer.PulseSw(71)
PlaySound SoundFXDOF("Bumper2",106,DOFPulse,DOFContactors)
End Sub


'Outhole

Sub Drain_Hit():Playsound "drain":bsTrough.AddBall Me:End Sub
'Sub Drain_Hit():Playsound "drain":me.destroyball:End Sub	'Debug

'Ramps Top

Sub Ramp1_Hit():PlaySound "Ramp_Hit1", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0:End Sub 'PlaySound "name",loopcount,volume,pan,randompitch
Sub Ramp2_Hit():PlaySound "Ramp_Hit1", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0:End Sub

Sub Ramp3_Hit():PlaySound "Ramp_Hit1", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0:End Sub 'PlaySound "name",loopcount,volume,pan,randompitch
Sub Ramp4_Hit():PlaySound "Ramp_Hit1", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0:End Sub

Sub RHelp1_Hit():Playsound "ramp_hit3",0,1,-0.06:DOF 107, DOFPulse:End Sub
Sub RHelp2_Hit():Playsound "ramp_hit3",0,1,0.06:DOF 108, DOFPulse:End Sub

' Holes

Sub ArmsLock_Hit:PlaySound "kicker_enter":vpmTimer.PulseSw 43:End Sub
Sub LegsLock_Hit:PlaySound "kicker_enter":vpmTimer.PulseSw 73:End Sub

'***************
' Special lights
'***************

Set LampCallback = GetRef("UpdateMultipleLamps")

Sub UpdateMultipleLamps

	' Robot animation

	Current12 = l12.State
	if Current12 <> Last12 Then
'		if RobotLightsOn = 1 then
'			StartRobotAnimation
'			StartRobotLights
'		end if
			StartRobotAnimation
	end if
	Last12 = Current12

	' Robot lights

'	Current13 = l13.State
'	if Current13 <> Last13 Then
'		if Current13 = 1 then
'			StartRobotLights
'			LightSeqTimer.Enabled=0
'			LightSeqTimer.Interval=1000
'		else								'StopRobotLights
'		maybestoprobotlights
'		'If CurrentRot<0 then StopRobotLights else LightSeqTimer.enabled=1
'		end if
'	end if
'	Last13 = Current13


	'Check BallTrough
	Current14 = l14.State
	if Current14 <> Last14 Then
		if Current14 = 1 then
			if bsTrough.Balls then bsTrough.ExitSol_On
		end if
	end if
	Last14 = Current14
End Sub

	'Robot Light Sequence Protector
'Sub	LightSeqTimer_Timer()
'	StopRobotLights
'	Me.Enabled=0
'End Sub


'================VP10 Fading Lamps Script

Dim LampState(200), FadingLevel(200)
Dim FlashSpeedUp(200), FlashSpeedDown(200), FlashMin(200), FlashMax(200), FlashLevel(200)

InitLamps() 
LampTimer.Interval = 10
LampTimer.Enabled = 1


Sub LampTimer_Timer()
    Dim chgLamp, num, chg, ii
    chgLamp = Controller.ChangedLamps
    If Not IsEmpty(chgLamp) Then
        For ii = 0 To UBound(chgLamp)
            LampState(chgLamp(ii, 0) ) = chgLamp(ii, 1)       'keep the real state in an array
            FadingLevel(chgLamp(ii, 0) ) = chgLamp(ii, 1) + 4 'actual fading step
        Next

    End If

    UpdateLamps
End Sub

Sub UpdateLamps
	NFadeL 2, l2 'FadeL
	NFadeL 3, l3 'FadeL 
	NFadeL 5, l5 'FadeL
	NFadeL 6, l6 'FadeL
	NFadeL 7, l7 'FadeL
	NFadeL 8, l8 'FadeL
	NFadeL 9, l9 'FadeL
	NFadeL 10, l10 'FadeL
	NFadeL 11, l11 'FadeL
	NFadeL 12, l12 'start robot animation

'	NFadeL 13, l13 'start robot flash lights
	NFadeLS 13, l13 'start robot flash lights

	NFadeL 14, l14 'check balltrough
	NFadeL 15, l15 'FadeL
	NFadeL 16, l16 'FadeL
	NFadeL 17, l17 'FadeL
	NFadeL 18, l18 'FadeL
	NFadeL 19, l19 'FadeL

'	NFadeL 20, l20 'FadeL
'	NFadeL 21, l21 'FadeL
'	NFadeL 22, l22 'FadeL
'	NFadeL 23, l23 'FadeL
	NFadeL 24, l24 'FadeL

	NFadeLm 20, l20 'FadeL
	NFadeLm 21, l21 'FadeL
	NFadeLm 22, l22 'FadeL
	NFadeLm 23, l23 'FadeL
	NFadeLm 20, l20a 'FadeL
	NFadeLm 21, l21a 'FadeL
	NFadeLm 22, l22a 'FadeL
	NFadeLm 23, l23a 'FadeL

'	NFadeL 25, l25 'FadeL
'	NFadeL 26, l26 'FadeL
'	NFadeL 27, l27 'FadeL
	NFadeLwf2 25, l25, l25F, l25F2 'FadeL
	NFadeLwf2 26, l26, l26F, l26F2 'FadeL
	NFadeLwf2 27, l27, l27F, l27F2 'FadeL

	Flash 28, A_RMS
	Flash 29, AR_MS
	Flash 30, ARM_S
	Flash 31, ARMS_
	Flash 32, B_RAIN
	Flash 33, BR_AIN
	Flash 34, BRA_IN
	Flash 35, BRAI_N
	Flash 36, BRAIN_
	Flash 37, B_ODY
	Flash 38, BO_DY
	Flash 39, BOD_Y
	Flash 40, BODY_
	Flash 41, L_EGS
	Flash 42, LE_GS
	Flash 43, LEG_S
	Flash 44, LEGS_

	NFadeL 45, l45 'FadeL
	NFadeL 46, l46 'FadeL
	NFadeLm 47, l47b 'FadeLm
	NFadeL 47, l47 'FadeL
	NFadeLm 51, l51b'FadeLm
	NFadeL 51, l51 'FadeL
End Sub

Sub InitLamps()
    Dim x
    For x = 0 to 200
        LampState(x) = 0        ' current light state, independent of the fading level. 0 is off and 1 is on
        FadingLevel(x) = 4      ' used to track the fading state
        FlashSpeedUp(x) = 0.2   ' faster speed when turning on the flasher
        FlashSpeedDown(x) = 0.1 ' slower speed when turning off the flasher
        FlashMax(x) = 1         ' the maximum value when on, usually 1
        FlashMin(x) = 0.05         ' the minimum value when off, usually 0
        FlashLevel(x) = 0       ' the intensity of the flashers, usually from 0 to 1
    Next
End Sub

Sub AllLampsOff
    Dim x
    For x = 0 to 200
        SetLamp x, 0
    Next
End Sub

Sub SetLamp(nr, value)
    If value <> LampState(nr) Then
        LampState(nr) = abs(value)
        FadingLevel(nr) = abs(value) + 4
    End If
End Sub

'Walls

' Lights: used for VP10 standard lights, the fading is handled by VP itself

Sub NFadeL(nr, object)
    Select Case FadingLevel(nr)
        Case 4:object.state = 0:FadingLevel(nr) = 0
        Case 5:object.state = 1:FadingLevel(nr) = 1
    End Select
End Sub

'Special - Lights Robot Lights
Sub NFadeLS(nr, object)
    Select Case FadingLevel(nr)
        Case 4:object.state = 0:FadingLevel(nr) = 0:LightSeqTimer.enabled = 1
        Case 5:object.state = 1:FadingLevel(nr) = 1:StartRobotLights:LightSeqTimer.interval = 300
    End Select
End Sub

Sub LightSeqTimer_Timer()
	StopRobotLights
	me.enabled = 0
end sub

'LightSeqTimer
'StartRobotLights
'StopRobotLights


Sub NFadeLm(nr, object) ' used for multiple lights
    Select Case FadingLevel(nr)
        Case 4:object.state = 0
        Case 5:object.state = 1
    End Select
End Sub

Sub FadeLm(nr, a, b) 'Old
	Select Case LampState(nr)
		Case 2:b.state = 0
		Case 3:b.state = 1
		Case 4:a.state = 0
		Case 5:b.state = 1
		Case 6:a.state = 1
	End Select
End Sub

'Lights, Ramps & Primitives used as 4 step fading lights
'a,b,c,d are the images used from on to off

Sub FadeObj(nr, object, a, b, c, d)
    Select Case FadingLevel(nr)
        Case 4:object.image = b:FadingLevel(nr) = 6                   'fading to off...
        Case 5:object.image = a:FadingLevel(nr) = 1                   'ON
        Case 6, 7, 8:FadingLevel(nr) = FadingLevel(nr) + 1             'wait
        Case 9:object.image = c:FadingLevel(nr) = FadingLevel(nr) + 1 'fading...
        Case 10, 11, 12:FadingLevel(nr) = FadingLevel(nr) + 1         'wait
        Case 13:object.image = d:FadingLevel(nr) = 0                  'Off
    End Select
End Sub

Sub FadeObjm(nr, object, a, b, c, d)
    Select Case FadingLevel(nr)
        Case 4:object.image = b
        Case 5:object.image = a
        Case 9:object.image = c
        Case 13:object.image = d
    End Select
End Sub

Sub NFadeObj(nr, object, a, b)
    Select Case FadingLevel(nr)
        Case 4:object.image = b:FadingLevel(nr) = 0 'off
        Case 5:object.image = a:FadingLevel(nr) = 1 'on
    End Select
End Sub

Sub NFadeObjm(nr, object, a, b)
    Select Case FadingLevel(nr)
        Case 4:object.image = b
        Case 5:object.image = a
    End Select
End Sub

' Flasher objects

Sub Flash(nr, object)
    Select Case FadingLevel(nr)
        Case 4 'off
            FlashLevel(nr) = FlashLevel(nr) - FlashSpeedDown(nr)
            If FlashLevel(nr) < FlashMin(nr) Then
                FlashLevel(nr) = FlashMin(nr)
                FadingLevel(nr) = 0 'completely off
            End if
            Object.IntensityScale = FlashLevel(nr)
        Case 5 ' on
            FlashLevel(nr) = FlashLevel(nr) + FlashSpeedUp(nr)
            If FlashLevel(nr) > FlashMax(nr) Then
                FlashLevel(nr) = FlashMax(nr)
                FadingLevel(nr) = 1 'completely on
            End if
            Object.IntensityScale = FlashLevel(nr)
    End Select
        '   Object.IntensityScale = 1
End Sub

Sub Flashm(nr, object) 'multiple flashers, it just sets the flashlevel
    Object.IntensityScale = FlashLevel(nr)
         ' Object.IntensityScale = 1
End Sub

Sub NFadeLwF(nr, object1, object2)
    Select Case FadingLevel(nr)
'		Case 0:If object2.intensityscale > 0 then Object2.intensityscale = object2.intensityscale + (object1.fadespeeddown * -1) *2 end if
'		Case 1:If object2.intensityscale < 1 then Object2.intensityscale = object2.intensityscale + (object1.fadespeedup) *2 end if

		Case 0:object2.intensityscale = 0
		Case 1:object2.intensityscale = 1
        Case 4:object1.state = 0:FadingLevel(nr) = 16
        Case 5:object1.state = 1:FadingLevel(nr) = 6':TextBox4.text = object1.fadespeedup	'to 6
'0.1 up, 0.1 down
		Case 6, 7, 8, 9, 10, 11, 12, 13, 14:If object2.intensityscale < 1 then Object2.intensityscale = object2.intensityscale + 0.1 end if:FadingLevel(nr) = FadingLevel(nr) + 1
		Case 15:If object2.intensityscale < 1 then Object2.intensityscale = object2.intensityscale + 0.1 end if:FadingLevel(nr) = 1':TextBox4.text = "Case 11"
		Case 16, 17, 18, 19, 20, 21, 22, 23, 24:If object2.intensityscale > 0 then Object2.intensityscale = object2.intensityscale + -0.1 end if:FadingLevel(nr) = FadingLevel(nr) + 1
		Case 25:If object2.intensityscale > 0 then Object2.intensityscale = object2.intensityscale + -0.1 end if:FadingLevel(nr) = 0':TextBox4.text = "Case 26"
    End Select
End Sub

Sub NFadeLwF2(nr, object1, object2, object3)	'one light two flashers
    Select Case FadingLevel(nr)

		Case 0:object2.intensityscale = 0:object3.intensityscale = object2.intensityscale
		Case 1:object2.intensityscale = 1:object3.intensityscale = object2.intensityscale
        Case 4:object1.state = 0:FadingLevel(nr) = 16
        Case 5:object1.state = 1:FadingLevel(nr) = 6':TextBox4.text = object1.fadespeedup	'to 6
'0.1 up, 0.1 down
		Case 6, 7, 8, 9, 10, 11, 12, 13, 14:If object2.intensityscale < 1 then Object2.intensityscale = object2.intensityscale + 0.1 end if:object3.intensityscale = object2.intensityscale: FadingLevel(nr) = FadingLevel(nr) + 1
		Case 15:If object2.intensityscale < 1 then Object2.intensityscale = object2.intensityscale + 0.1 end if:FadingLevel(nr) = 1:object3.intensityscale = object2.intensityscale':TextBox4.text = "Case 11"
		Case 16, 17, 18, 19, 20, 21, 22, 23, 24:If object2.intensityscale > 0 then Object2.intensityscale = object2.intensityscale + -0.1 end if:object3.intensityscale = object2.intensityscale :FadingLevel(nr) = FadingLevel(nr) + 1
		Case 25:If object2.intensityscale > 0 then Object2.intensityscale = object2.intensityscale + -0.1 end if:FadingLevel(nr) = 0:object3.intensityscale = object2.intensityscale':TextBox4.text = "Case 26"

	end select
End Sub

' Desktop Objects: Reels & texts (you may also use lights on the desktop)

' Reels

Sub FadeR(nr, object)
    Select Case FadingLevel(nr)
        Case 4:object.SetValue 1:FadingLevel(nr) = 6                   'fading to off...
        Case 5:object.SetValue 0:FadingLevel(nr) = 1                   'ON
        Case 6, 7, 8:FadingLevel(nr) = FadingLevel(nr) + 1              'wait
        Case 9:object.SetValue 2:FadingLevel(nr) = FadingLevel(nr) + 1 'fading...
        Case 10, 11, 12:FadingLevel(nr) = FadingLevel(nr) + 1          'wait
        Case 13:object.SetValue 3:FadingLevel(nr) = 0                  'Off
    End Select
End Sub

Sub FadeRm(nr, object)
    Select Case FadingLevel(nr)
        Case 4:object.SetValue 1
        Case 5:object.SetValue 0
        Case 9:object.SetValue 2
        Case 3:object.SetValue 3
    End Select
End Sub

'Texts

Sub NFadeT(nr, object, message)
    Select Case FadingLevel(nr)
        Case 4:object.Text = "":FadingLevel(nr) = 0
        Case 5:object.Text = message:FadingLevel(nr) = 1
    End Select
End Sub

Sub NFadeTm(nr, object, b)
    Select Case FadingLevel(nr)
        Case 4:object.Text = ""
        Case 5:object.Text = message
    End Select
End Sub



' *********************************************************************
'                      Supporting Ball & Sound Functions
' *********************************************************************

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

Function Vol2(ball1, ball2) ' Calculates the Volume of the sound based on the speed of two balls
    Vol2 = (Vol(ball1) + Vol(ball2) ) / 2
End Function

Function Pan(ball) ' Calculates the pan for a ball based on the X position on the table. "table1" is the name of the table
    Dim tmp
    tmp = ball.x * 2 / Genesis.width-1
    If tmp> 0 Then
        Pan = Csng(tmp ^10)
    Else
        Pan = Csng(-((- tmp) ^10) )
    End If
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
'*****************************************
'      JP's VP10 Rolling 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 RollingUpdate()
    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

    ' play the rolling sound for each ball
    For b = 0 to UBound(BOT)
        If BallVel(BOT(b) ) > 1 AND BOT(b).z < 30 Then
            rolling(b) = True
            PlaySound("fx_ballrolling" & b), -1, Vol(BOT(b) ), Pan(BOT(b) ), 0, Pitch(BOT(b) ), 1, 0
        Else
            If rolling(b) = True Then
                StopSound("fx_ballrolling" & b)
                rolling(b) = False
            End If
        End If
    Next
End Sub

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

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


'===============================================================

' Extra Sounds


Sub PlasticRamps_Hit (idx)
	PlaySound "flip_hit_3", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 0, 0
End Sub

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

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

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

Sub Metals_Hit (idx) 'Inlanes & shooter lane
	PlaySound "metalhit2", 0, Vol(ActiveBall)*2, Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
End Sub

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

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

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

Sub RubberPosts_Hit(idx)
 	dim finalspeed
  	finalspeed=SQR(activeball.velx * activeball.velx + activeball.vely * activeball.vely)
 	If finalspeed > 16 then 
		PlaySound "fx_rubber2", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
	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), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
		Case 2 : PlaySound "rubber_hit_2", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
		Case 3 : PlaySound "rubber_hit_3", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
	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), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
		Case 2 : PlaySound "flip_hit_2", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
		Case 3 : PlaySound "flip_hit_3", 0, Vol(ActiveBall), Pan(ActiveBall), 0, Pitch(ActiveBall), 1, 0
	End Select
End Sub


'Animated rubbers
'Sub Rubber_Straightb8_hit()
'	Rubber_Straightb8.size_x = 90
'	Rubberanim.enabled = 1
'End Sub

'Sub Rubber_Straightb14_hit()
'	Rubber_Straightb14.size_x = 90
'	Rubberanim.enabled = 1
'End Sub

'Sub Rubber_Straightb10_hit()
'	Rubber_Straightb10.size_x = 90
'	Rubberanim.enabled = 1
'End Sub
'Sub Rubber_Straightb5_hit()
'	Rubber_Straightb5.size_x = 90
'	Rubberanim.enabled = 1
'End Sub

'Sub Rubberanim_timer()
'	Rubber_Straightb8.size_x = 100
'	Rubber_Straightb14.size_x = 100
'	Rubber_Straightb10.size_x = 100
'	Rubber_Straightb5.size_x = 100
'	me.enabled = 0
'End Sub

' Eala's rutine
 Dim Digits(40)
 Digits(0)=Array(f01_1, f02_1, f03_1, f04_1, f05_1, f06_1, f07_1, f08_1, f09_1, f10_1, f11_1, f12_1, f13_1, f14_1, f15_1, f16_1)
 Digits(1)=Array(f01_2, f02_2, f03_2, f04_2, f05_2, f06_2, f07_2, f08_2, f09_2, f10_2, f11_2, f12_2, f13_2, f14_2, f15_2, f16_2)
 Digits(2)=Array(f01_3, f02_3, f03_3, f04_3, f05_3, f06_3, f07_3, f08_3, f09_3, f10_3, f11_3, f12_3, f13_3, f14_3, f15_3, f16_3)
 Digits(3)=Array(f01_4, f02_4, f03_4, f04_4, f05_4, f06_4, f07_4, f08_4, f09_4, f10_4, f11_4, f12_4, f13_4, f14_4, f15_4, f16_4)
 Digits(4)=Array(f01_5, f02_5, f03_5, f04_5, f05_5, f06_5, f07_5, f08_5, f09_5, f10_5, f11_5, f12_5, f13_5, f14_5, f15_5, f16_5)
 Digits(5)=Array(f01_6, f02_6, f03_6, f04_6, f05_6, f06_6, f07_6, f08_6, f09_6, f10_6, f11_6, f12_6, f13_6, f14_6, f15_6, f16_6)
 Digits(6)=Array(f01_7, f02_7, f03_7, f04_7, f05_7, f06_7, f07_7, f08_7, f09_7, f10_7, f11_7, f12_7, f13_7, f14_7, f15_7, f16_7)
 Digits(7)=Array(f01_8, f02_8, f03_8, f04_8, f05_8, f06_8, f07_8, f08_8, f09_8, f10_8, f11_8, f12_8, f13_8, f14_8, f15_8, f16_8)
 Digits(8)=Array(f01_9, f02_9, f03_9, f04_9, f05_9, f06_9, f07_9, f08_9, f09_9, f10_9, f11_9, f12_9, f13_9, f14_9, f15_9, f16_9)
 Digits(9)=Array(f01_10, f02_10, f03_10, f04_10, f05_10, f06_10, f07_10, f08_10, f09_10, f10_10, f11_10, f12_10, f13_10, f14_10, f15_10, f16_10)
 Digits(10)=Array(f01_11, f02_11, f03_11, f04_11, f05_11, f06_11, f07_11, f08_11, f09_11, f10_11, f11_11, f12_11, f13_11, f14_11, f15_11, f16_11)
 Digits(11)=Array(f01_12, f02_12, f03_12, f04_12, f05_12, f06_12, f07_12, f08_12, f09_12, f10_12, f11_12, f12_12, f13_12, f14_12, f15_12, f16_12)
 Digits(12)=Array(f01_13, f02_13, f03_13, f04_13, f05_13, f06_13, f07_13, f08_13, f09_13, f10_13, f11_13, f12_13, f13_13, f14_13, f15_13, f16_13)
 Digits(13)=Array(f01_14, f02_14, f03_14, f04_14, f05_14, f06_14, f07_14, f08_14, f09_14, f10_14, f11_14, f12_14, f13_14, f14_14, f15_14, f16_14)
 Digits(14)=Array(f01_15, f02_15, f03_15, f04_15, f05_15, f06_15, f07_15, f08_15, f09_15, f10_15, f11_15, f12_15, f13_15, f14_15, f15_15, f16_15)
 Digits(15)=Array(f01_16, f02_16, f03_16, f04_16, f05_16, f06_16, f07_16, f08_16, f09_16, f10_16, f11_16, f12_16, f13_16, f14_16, f15_16, f16_16)
 Digits(16)=Array(f01_17, f02_17, f03_17, f04_17, f05_17, f06_17, f07_17, f08_17, f09_17, f10_17, f11_17, f12_17, f13_17, f14_17, f15_17, f16_17)
 Digits(17)=Array(f01_18, f02_18, f03_18, f04_18, f05_18, f06_18, f07_18, f08_18, f09_18, f10_18, f11_18, f12_18, f13_18, f14_18, f15_18, f16_18)
 Digits(18)=Array(f01_19, f02_19, f03_19, f04_19, f05_19, f06_19, f07_19, f08_19, f09_19, f10_19, f11_19, f12_19, f13_19, f14_19, f15_19, f16_19)
 Digits(19)=Array(f01_20, f02_20, f03_20, f04_20, f05_20, f06_20, f07_20, f08_20, f09_20, f10_20, f11_20, f12_20, f13_20, f14_20, f15_20, f16_20)
 Digits(20)=Array(f01_21, f02_21, f03_21, f04_21, f05_21, f06_21, f07_21, f08_21, f09_21, f10_21, f11_21, f12_21, f13_21, f14_21, f15_21, f16_21)
 Digits(21)=Array(f01_22, f02_22, f03_22, f04_22, f05_22, f06_22, f07_22, f08_22, f09_22, f10_22, f11_22, f12_22, f13_22, f14_22, f15_22, f16_22)
 Digits(22)=Array(f01_23, f02_23, f03_23, f04_23, f05_23, f06_23, f07_23, f08_23, f09_23, f10_23, f11_23, f12_23, f13_23, f14_23, f15_23, f16_23)
 Digits(23)=Array(f01_24, f02_24, f03_24, f04_24, f05_24, f06_24, f07_24, f08_24, f09_24, f10_24, f11_24, f12_24, f13_24, f14_24, f15_24, f16_24)
 Digits(24)=Array(f01_25, f02_25, f03_25, f04_25, f05_25, f06_25, f07_25, f08_25, f09_25, f10_25, f11_25, f12_25, f13_25, f14_25, f15_25, f16_25)
 Digits(25)=Array(f01_26, f02_26, f03_26, f04_26, f05_26, f06_26, f07_26, f08_26, f09_26, f10_26, f11_26, f12_26, f13_26, f14_26, f15_26, f16_26)
 Digits(26)=Array(f01_27, f02_27, f03_27, f04_27, f05_27, f06_27, f07_27, f08_27, f09_27, f10_27, f11_27, f12_27, f13_27, f14_27, f15_27, f16_27)
 Digits(27)=Array(f01_28, f02_28, f03_28, f04_28, f05_28, f06_28, f07_28, f08_28, f09_28, f10_28, f11_28, f12_28, f13_28, f14_28, f15_28, f16_28)
 Digits(28)=Array(f01_29, f02_29, f03_29, f04_29, f05_29, f06_29, f07_29, f08_29, f09_29, f10_29, f11_29, f12_29, f13_29, f14_29, f15_29, f16_29)
 Digits(29)=Array(f01_30, f02_30, f03_30, f04_30, f05_30, f06_30, f07_30, f08_30, f09_30, f10_30, f11_30, f12_30, f13_30, f14_30, f15_30, f16_30)
 Digits(30)=Array(f01_31, f02_31, f03_31, f04_31, f05_31, f06_31, f07_31, f08_31, f09_31, f10_31, f11_31, f12_31, f13_31, f14_31, f15_31, f16_31)
 Digits(31)=Array(f01_32, f02_32, f03_32, f04_32, f05_32, f06_32, f07_32, f08_32, f09_32, f10_32, f11_32, f12_32, f13_32, f14_32, f15_32, f16_32)
 Digits(32)=Array(f01_33, f02_33, f03_33, f04_33, f05_33, f06_33, f07_33, f08_33, f09_33, f10_33, f11_33, f12_33, f13_33, f14_33, f15_33, f16_33)
 Digits(33)=Array(f01_34, f02_34, f03_34, f04_34, f05_34, f06_34, f07_34, f08_34, f09_34, f10_34, f11_34, f12_34, f13_34, f14_34, f15_34, f16_34)
 Digits(34)=Array(f01_35, f02_35, f03_35, f04_35, f05_35, f06_35, f07_35, f08_35, f09_35, f10_35, f11_35, f12_35, f13_35, f14_35, f15_35, f16_35)
 Digits(35)=Array(f01_36, f02_36, f03_36, f04_36, f05_36, f06_36, f07_36, f08_36, f09_36, f10_36, f11_36, f12_36, f13_36, f14_36, f15_36, f16_36)
 Digits(36)=Array(f01_37, f02_37, f03_37, f04_37, f05_37, f06_37, f07_37, f08_37, f09_37, f10_37, f11_37, f12_37, f13_37, f14_37, f15_37, f16_37)
 Digits(37)=Array(f01_38, f02_38, f03_38, f04_38, f05_38, f06_38, f07_38, f08_38, f09_38, f10_38, f11_38, f12_38, f13_38, f14_38, f15_38, f16_38)
 Digits(38)=Array(f01_39, f02_39, f03_39, f04_39, f05_39, f06_39, f07_39, f08_39, f09_39, f10_39, f11_39, f12_39, f13_39, f14_39, f15_39, f16_39)
 Digits(39)=Array(f01_40, f02_40, f03_40, f04_40, f05_40, f06_40, f07_40, f08_40, f09_40, f10_40, f11_40, f12_40, f13_40, f14_40, f15_40, f16_40)
     

 
 Sub Displaytimer_Timer
    Dim ChgLED, ii, jj, num, chg, stat, obj, b, x
    ChgLED=Controller.ChangedLEDs(&Hffffffff, &Hffffffff)
    If Not IsEmpty(ChgLED)Then
       For ii=0 To UBound(chgLED)
          num=chgLED(ii, 0) : chg=chgLED(ii, 1) : stat=chgLED(ii, 2)
          For Each obj In Digits(num)
             If chg And 1 Then obj.visible=stat And 1
'             If chg And 1 Then obj.State=stat And 1
             chg=chg\2 : stat=stat\2
          Next
       Next
    End If
 End Sub



'Gottlieb Genesis
'added by Inkochnito
Sub editDips
	Dim vpmDips:Set vpmDips = New cvpmDips
	With vpmDips
		.AddForm 700, 400, "Genesis - DIP switches"
		.AddFrame 2, 4, 190, "Maximum credits", 49152, Array("8 credits", 0, "10 credits", 32768, "15 credits", &H00004000, "20 credits", 49152)                                                                                  'dip 15&16
		.AddFrame 2, 80, 190, "Coin chute 1 and 2 control", &H00002000, Array("seperate", 0, "same", &H00002000)                                                                                                                  'dip 14
		.AddFrame 2, 126, 190, "Playfield special", &H00200000, Array("replay", 0, "extra ball", &H00200000)                                                                                                                      'dip 22
		.AddFrame 2, 172, 190, "High games to date control", &H00000020, Array("no effect", 0, "reset high games 2-5 on power off", &H00000020)                                                                                   'dip 6
		.AddFrame 2, 218, 190, "Completing drop target sequence", &H00000080, Array("adds a letter to most complete part", 0, "spots a letter to each part", &H00000080)                                                          'dip 8
		.AddFrame 2, 264, 190, "Special lights after", &H40000000, Array("Hitting 'Lifeforce' when flashing", 0, "completing all body parts", &H40000000)                                                                         'dip 31
		.AddFrame 2, 310, 190, "Extra ball after completing", &H80000000, Array("4 body parts during the same ball", 0, "3 body parts during the same ball", &H80000000)                                                          'dip 32
		.AddFrame 205, 4, 190, "High game to date awards", &H00C00000, Array("not displayed and no award", 0, "displayed and no award", &H00800000, "displayed and 2 replays", &H00400000, "displayed and 3 replays", &H00C00000) 'dip 23&24
		.AddFrame 205, 80, 190, "Balls per game", &H01000000, Array("5 balls", 0, "3 balls", &H01000000)                                                                                                                          'dip 25
		.AddFrame 205, 126, 190, "Replay limit", &H04000000, Array("no limit", 0, "one per game", &H04000000)                                                                                                                     'dip 27
		.AddFrame 205, 172, 190, "Novelty", &H08000000, Array("normal", 0, "extra ball and replay scores points", &H08000000)                                                                                                     'dip 28
		.AddFrame 205, 218, 190, "Game mode", &H10000000, Array("replay", 0, "extra ball", &H10000000)                                                                                                                            'dip 29
		.AddFrame 205, 264, 190, "3rd coin chute credits control", &H20000000, Array("no effect", 0, "add 9", &H20000000)                                                                                                         'dip 30
		.AddChk 205, 316, 180, Array("Match feature", &H02000000)                                                                                                                                                                 'dip 26
		.AddChk 205, 331, 190, Array("Attract sound", &H00000040)                                                                                                                                                                 'dip 7
		.AddLabel 50, 360, 300, 20, "After hitting OK, press F3 to reset game with new settings."
		.ViewDips
	End With
End Sub

Set vpmShowDips = GetRef("editDips")

' Rules
Sub Rules()
	Dim Msg(32)
	Msg(0) = "Genesis - Gottlieb 1986" &Chr(10) &Chr(10)
	Msg(1) = ""
	Msg(2) = "SPECIAL: Completing all Body Parts lights LIFEFORCE"
	Msg(3) = "  Hitting the Vari-Target all the way back lights SPECIAL"
	Msg(4) = ""
	Msg(5) = "EXTRA BALL: Completing 3 Body Parts lights EXTRA BALL"
	Msg(6) = "  Completing next Body Part awards EXTRA BALL"
	Msg(7) = ""
	Msg(8) = "SCORING MULTIPLIER: Completing Body Parts when needed"
	Msg(9) = "  advances Scoreing Multiplier"
	Msg(10) = ""
	Msg(11) = "MULTI-MULTIPLIER: Scoring Multiplier is doubled during Multi-Ball play"
	Msg(12) = ""
	Msg(13) = "BODY PARTS LETTERS: Letters awarded bt hitting Vari-target"
	Msg(14) = "  all the way back or by scoring Flashing Targets or Sequences."
	Msg(15) = "  Return Rollovers flash Vari-Target for a period of time."
	Msg(16) = "  Hitting Vari-Target all the way back when flashing"
	Msg(17) = "  awards a letter in all Body Parts."
	Msg(18) = "  Completing the Drop Target Sequence (1-2-3) awards"
	Msg(19) = "  a letter in the most complete Body Part."
	Msg(20) = ""
	Msg(21) = "LIFEFORCE: Expose Robot by hitting Vari-target all the way back"
	Msg(22) = "  when LIFEFORCE is flashing."
	Msg(23) = ""
	Msg(24) = "MULTIBALL: Completing Body Part when needed enables ramp for capture"
	Msg(25) = ""
	Msg(26) = "ENTERING INITIALS: Enter letter by presing Flippers and Credit Button."
	Msg(27) = ""
	Msg(28) = ""

	For X = 1 To 28
		Msg(0) = Msg(0) + Msg(X) &Chr(13)
	Next

	MsgBox Msg(0), , "         Instructions and Rule Card"
End Sub

'flexdmd image constants
Const DMD_A = "VPX.DMD_A"
Const DMD_B = "VPX.DMD_B"
Const DMD_C = "VPX.DMD_C"
Const DMD_D = "VPX.DMD_D"
Const DMD_E = "VPX.DMD_E"
Const DMD_F = "VPX.DMD_F"
Const DMD_G = "VPX.DMD_G"
Const DMD_H = "VPX.DMD_H"
Const DMD_I = "VPX.DMD_I"
Const DMD_J = "VPX.DMD_J"
Const DMD_K = "VPX.DMD_K"
Const DMD_L = "VPX.DMD_L"
Const DMD_M = "VPX.DMD_M"
Const DMD_N = "VPX.DMD_N"
Const DMD_O = "VPX.DMD_O"
Const DMD_P = "VPX.DMD_P"
Const DMD_Q = "VPX.DMD_Q"
Const DMD_R = "VPX.DMD_R"
Const DMD_S = "VPX.DMD_S"
Const DMD_T = "VPX.DMD_T"
Const DMD_U = "VPX.DMD_U"
Const DMD_V = "VPX.DMD_V"
Const DMD_W = "VPX.DMD_W"
Const DMD_X = "VPX.DMD_X"
Const DMD_Y = "VPX.DMD_Y"
Const DMD_Z = "VPX.DMD_Z"

Const DMD_1 = "VPX.DMD_1"
Const DMD_2 = "VPX.DMD_2"
Const DMD_3 = "VPX.DMD_3"
Const DMD_4 = "VPX.DMD_4"
Const DMD_6 = "VPX.DMD_6"
Const DMD_7 = "VPX.DMD_7"
Const DMD_8 = "VPX.DMD_8"
Const DMD_9 = "VPX.DMD_9"

Const DMD_1dot = "VPX.DMD_1dot"
Const DMD_2dot = "VPX.DMD_2dot"
Const DMD_3dot = "VPX.DMD_3dot"
Const DMD_4dot = "VPX.DMD_4dot"
Const DMD_6dot = "VPX.DMD_6dot"
Const DMD_7dot = "VPX.DMD_7dot"
Const DMD_8dot = "VPX.DMD_8dot"
Const DMD_9dot = "VPX.DMD_9dot"

Const DMD_Odot = "VPX.DMD_Odot"
Const DMD_Sdot = "VPX.DMD_Sdot"

Const DMD_Space = "VPX.DMD_Space"
Const DMD_SpaceDot = "VPX.DMD_SpaceDot"

Const DMD_Ampersand = "VPX.DMD_Ampersand"
Const DMD_Asterick = "VPX.DMD_Asterick"
Const DMD_BSlash = "VPX.DMD_BSlash"
Const DMD_CloseBracket = "VPX.DMD_CloseBracket"
Const DMD_Colon = "VPX.DMD_Colon"
Const DMD_Dollar = "VPX.DMD_Dollar"
Const DMD_Equals = "VPX.DMD_Equals"
Const DMD_Exclamation = "VPX.DMD_Exclamation"
Const DMD_FSlash = "VPX.DMD_FSlash"
Const DMD_GreaterThan = "VPX.DMD_GreaterThan"
Const DMD_Hash = "VPX.DMD_Hash"
Const DMD_LessThan = "VPX.DMD_LessThan"
Const DMD_Minus = "VPX.DMD_Minus"
Const DMD_OpenBracket = "VPX.DMD_OpenBracket"
Const DMD_Percent = "VPX.DMD_Percent"
Const DMD_Plus = "VPX.DMD_Plus"
Const DMD_Question = "VPX.DMD_Question"
Const DMD_Quote = "VPX.DMD_Quote"
Const DMD_SemiColon = "VPX.DMD_SemiColon"
Const DMD_SingleQuote = "VPX.DMD_SingleQuote"


'**********************************************************
'  2*20 segment alphannumeric to flexdmd display conversion
'**********************************************************
Dim FlexDMD
DIm FlexDMDDict
Dim FlexDMDScene
Dim PremierFlag, BottomLine(19)

Sub FlexDMD_Init() 'default/startup values

	' flex dmd variables
	DIm FlexDMDFont
	Dim FlexPath

	' populate the lookup dictionary for mapping display characters
	FlexDictionary_Init

	dim i
	for i = 0 to 19
		BottomLine(i) = 0
	next
	PremierFlag = False
	
	'setup flex dmd
	Set FlexDMD = CreateObject("FlexDMD.FlexDMD")
	If Not FlexDMD is Nothing Then
	
		
		FlexDMD.GameName = cGameName
		FlexDMD.TableFile = Table1.Filename & ".vpx"
		FlexDMD.RenderMode = 2
		FlexDMD.Width = 128
		FlexDMD.Height = 32
		FlexDMD.Clear = True
		FlexDMD.Run = True

		FlexDMD.LockRenderThread

		Set FlexDMDScene = FlexDMD.NewGroup("Scene")
		

		With FlexDMDScene
			'populate blank display
			.AddActor FlexDMD.NewImage("Back", "VPX.DMD_Background")
			'40 segment display holders
			.AddActor FlexDMD.NewImage("Seg0", DMD_Space)
			.GetImage("Seg0").SetAlignedPosition 4,0,0
			.AddActor FlexDMD.NewImage("Seg1", DMD_Space)
			.GetImage("Seg1").SetAlignedPosition 10,0,0
			.AddActor FlexDMD.NewImage("Seg2", DMD_Space)
			.GetImage("Seg2").SetAlignedPosition 16,0,0
			.AddActor FlexDMD.NewImage("Seg3", DMD_Space)
			.GetImage("Seg3").SetAlignedPosition 22,0,0
			.AddActor FlexDMD.NewImage("Seg4", DMD_Space)
			.GetImage("Seg4").SetAlignedPosition 28,0,0
			.AddActor FlexDMD.NewImage("Seg5", DMD_Space)
			.GetImage("Seg5").SetAlignedPosition 34,0,0
			.AddActor FlexDMD.NewImage("Seg6", DMD_Space)
			.GetImage("Seg6").SetAlignedPosition 40,0,0
			.AddActor FlexDMD.NewImage("Seg7", DMD_Space)
			.GetImage("Seg7").SetAlignedPosition 46,0,0
			.AddActor FlexDMD.NewImage("Seg8", DMD_Space)
			.GetImage("Seg8").SetAlignedPosition 52,0,0
			.AddActor FlexDMD.NewImage("Seg9", DMD_Space)
			.GetImage("Seg9").SetAlignedPosition 58,0,0
			.AddActor FlexDMD.NewImage("Seg10", DMD_Space)
			.GetImage("Seg10").SetAlignedPosition 64,0,0
			.AddActor FlexDMD.NewImage("Seg11", DMD_Space)
			.GetImage("Seg11").SetAlignedPosition 70,0,0
			.AddActor FlexDMD.NewImage("Seg12", DMD_Space)
			.GetImage("Seg12").SetAlignedPosition 76,0,0
			.AddActor FlexDMD.NewImage("Seg13", DMD_Space)
			.GetImage("Seg13").SetAlignedPosition 82,0,0
			.AddActor FlexDMD.NewImage("Seg14", DMD_Space)
			.GetImage("Seg14").SetAlignedPosition 88,0,0
			.AddActor FlexDMD.NewImage("Seg15", DMD_Space)
			.GetImage("Seg15").SetAlignedPosition 94,0,0
			.AddActor FlexDMD.NewImage("Seg16", DMD_Space)
			.GetImage("Seg16").SetAlignedPosition 100,0,0
			.AddActor FlexDMD.NewImage("Seg17", DMD_Space)
			.GetImage("Seg17").SetAlignedPosition 106,0,0
			.AddActor FlexDMD.NewImage("Seg18", DMD_Space)
			.GetImage("Seg18").SetAlignedPosition 112,0,0
			.AddActor FlexDMD.NewImage("Seg19", DMD_Space)
			.GetImage("Seg19").SetAlignedPosition 118,0,0

			.AddActor FlexDMD.NewImage("Seg20", DMD_Space)
			.GetImage("Seg20").SetAlignedPosition 4,16,0
			.AddActor FlexDMD.NewImage("Seg21", DMD_Space)
			.GetImage("Seg21").SetAlignedPosition 10,16,0
			.AddActor FlexDMD.NewImage("Seg22", DMD_Space)
			.GetImage("Seg22").SetAlignedPosition 16,16,0
			.AddActor FlexDMD.NewImage("Seg23", DMD_Space)
			.GetImage("Seg23").SetAlignedPosition 22,16,0
			.AddActor FlexDMD.NewImage("Seg24", DMD_Space)
			.GetImage("Seg24").SetAlignedPosition 28,16,0
			.AddActor FlexDMD.NewImage("Seg25", DMD_Space)
			.GetImage("Seg25").SetAlignedPosition 34,16,0
			.AddActor FlexDMD.NewImage("Seg26", DMD_Space)
			.GetImage("Seg26").SetAlignedPosition 40,16,0
			.AddActor FlexDMD.NewImage("Seg27", DMD_Space)
			.GetImage("Seg27").SetAlignedPosition 46,16,0
			.AddActor FlexDMD.NewImage("Seg28", DMD_Space)
			.GetImage("Seg28").SetAlignedPosition 52,16,0
			.AddActor FlexDMD.NewImage("Seg29", DMD_Space)
			.GetImage("Seg29").SetAlignedPosition 58,16,0
			.AddActor FlexDMD.NewImage("Seg30", DMD_Space)
			.GetImage("Seg30").SetAlignedPosition 64,16,0
			.AddActor FlexDMD.NewImage("Seg31", DMD_Space)
			.GetImage("Seg31").SetAlignedPosition 70,16,0
			.AddActor FlexDMD.NewImage("Seg32", DMD_Space)
			.GetImage("Seg32").SetAlignedPosition 76,16,0
			.AddActor FlexDMD.NewImage("Seg33", DMD_Space)
			.GetImage("Seg33").SetAlignedPosition 82,16,0
			.AddActor FlexDMD.NewImage("Seg34", DMD_Space)
			.GetImage("Seg34").SetAlignedPosition 88,16,0
			.AddActor FlexDMD.NewImage("Seg35", DMD_Space)
			.GetImage("Seg35").SetAlignedPosition 94,16,0
			.AddActor FlexDMD.NewImage("Seg36", DMD_Space)
			.GetImage("Seg36").SetAlignedPosition 100,16,0
			.AddActor FlexDMD.NewImage("Seg37", DMD_Space)
			.GetImage("Seg37").SetAlignedPosition 106,16,0
			.AddActor FlexDMD.NewImage("Seg38", DMD_Space)
			.GetImage("Seg38").SetAlignedPosition 112,16,0
			.AddActor FlexDMD.NewImage("Seg39", DMD_Space)
			.GetImage("Seg39").SetAlignedPosition 118,16,0

			'score text overlays last
			.AddActor FlexDMD.NewImage("PremierRunners", "VPX.DMD_PremierRunners")
			.GetImage("PremierRunners").Visible = False
			.AddActor FlexDMD.NewImage("LogansRun", "VPX.DMD_LogansRunLogo")
			.GetImage("LogansRun").Visible = False
		
		End With
	
		FlexDMD.Stage.AddActor FlexDMDScene
		
		FlexDMD.Show = True
		FlexDMD.UnlockRenderThread

	End If

End Sub


Sub FlexDictionary_Init

	Set FlexDMDDict = CreateObject("Scripting.Dictionary")

	FlexDMDDict.Add 0, DMD_Space
	FlexDMDDict.Add 63, DMD_O
	FlexDMDDict.Add 8704, DMD_1
	FlexDMDDict.Add 2139, DMD_2
	FlexDMDDict.Add 2127, DMD_3
	FlexDMDDict.Add 2150, DMD_4
	FlexDMDDict.Add 2157, DMD_S
	FlexDMDDict.Add 2173, DMD_6
	FlexDMDDict.Add 7, DMD_7
	FlexDMDDict.Add 2175,DMD_8
	FlexDMDDict.Add 2159,DMD_9
	
	FlexDMDDict.Add 191,DMD_Odot
	FlexDMDDict.Add 8832, DMD_1dot
	FlexDMDDict.Add 2267, DMD_2dot
	FlexDMDDict.Add 2255, DMD_3dot
	FlexDMDDict.Add 2278, DMD_4dot
	FlexDMDDict.Add 2285, DMD_Sdot
	FlexDMDDict.Add 2301, DMD_6dot
	FlexDMDDict.Add 135, DMD_7dot
	FlexDMDDict.Add 2303, DMD_8dot
	FlexDMDDict.Add 2287, DMD_9dot
	
	FlexDMDDict.Add 2167, DMD_A
	FlexDMDDict.Add 10767, DMD_B
	FlexDMDDict.Add 57, DMD_C
	FlexDMDDict.Add 8719, DMD_D
	FlexDMDDict.Add 121, DMD_E
	FlexDMDDict.Add 113, DMD_F
	FlexDMDDict.Add 2109, DMD_G
	FlexDMDDict.Add 2166, DMD_H
	FlexDMDDict.Add 8713, DMD_I
	FlexDMDDict.Add 30, DMD_J
	FlexDMDDict.Add 5232, DMD_K
	FlexDMDDict.Add 56, DMD_L
	FlexDMDDict.Add 1334, DMD_M
	FlexDMDDict.Add 4406, DMD_N
	' "O" = 0
	FlexDMDDict.Add 2163, DMD_P
	FlexDMDDict.Add 4159, DMD_Q
	FlexDMDDict.Add 6259, DMD_R
	 ' "S" = 5
	FlexDMDDict.Add 8705, DMD_T
	FlexDMDDict.Add 62, DMD_U
	FlexDMDDict.Add 17456, DMD_V
	FlexDMDDict.Add 20534, DMD_W
	FlexDMDDict.Add 21760, DMD_X
	FlexDMDDict.Add 9472, DMD_Y
	FlexDMDDict.Add 17417, DMD_Z
	
	FlexDMDDict.Add &h400,DMD_SingleQuote
	FlexDMDDict.Add 16640, DMD_CloseBracket
	FlexDMDDict.Add 5120, DMD_OpenBracket
	FlexDMDDict.Add 2120, DMD_Equals
	FlexDMDDict.Add 10275, DMD_Question
	FlexDMDDict.Add 2112, DMD_Minus
	FlexDMDDict.Add 10861, DMD_Dollar
	FlexDMDDict.Add 6144, DMD_GreaterThan
	FlexDMDDict.Add 65535, DMD_Hash
	FlexDMDDict.Add 32576, DMD_Asterick
	FlexDMDDict.Add 10816, DMD_Plus
	
End sub

Sub UpdateFlexChar(id, value)

	If id < 40 Then
		if FlexDMDDict.Exists (value) then
			FlexDMDScene.GetImage("Seg" & id).Bitmap = FlexDMD.NewImage("", FlexDMDDict.Item (value)).Bitmap
		Else
			FlexDMDScene.GetImage("Seg" & id).Bitmap = FlexDMD.NewImage("", DMD_Space).Bitmap
		end if
		'basic text tracking
		if id =2 then
			if value = 2163 Then
				PremierFlag = True
			Else	
				PremierFlag = False
			end if
		End if
		if id > 19 Then
			BottomLine(id - 20) = value
		end if
	End If
	If Controller.Solenoid(10) = True Then
		'ball in play. Hide premier runners / logans run text
		FlexDMDScene.GetImage("LogansRun").Visible = False
		FlexDMDScene.GetImage("PremierRunners").Visible = False
	
	Else
		'overwrite text with image checks
		if PremierFlag = True Then
			FlexDMDScene.GetImage("LogansRun").Visible = False
			FlexDMDScene.GetImage("PremierRunners").Visible = True
		elseif join(BottomLine,"") = 0 Then
			FlexDMDScene.GetImage("LogansRun").Visible = True
			FlexDMDScene.GetImage("PremierRunners").Visible = False
		Else
			'in game
			FlexDMDScene.GetImage("LogansRun").Visible = False
			FlexDMDScene.GetImage("PremierRunners").Visible = False
		End If
	End if
	

End Sub

Sub DisplayTimer_Timer

	If UseFlexDMD then 
		Dim ChgLED, ii, num, stat
		ChgLED=Controller.ChangedLEDs(&Hffffffff, &Hffffffff)

		If Not IsEmpty(ChgLED)Then
			If Not FlexDMD is Nothing Then FlexDMD.LockRenderThread
			For ii=0 To UBound(chgLED)
				num=chgLED(ii, 0) : stat=chgLED(ii, 2)
				UpdateFlexChar num, stat
			Next
			If Not FlexDMD is Nothing Then FlexDMD.UnlockRenderThread
		End if
		
	Else
		DisplayTimer.Enabled = False
	End If
 End Sub

Perhaps Scutter (or another person) explain me why it doesn't work.

Thank you very much and continue to bring the world of pincab to life

Edited by Citron68, 27 January 2023 - 02:13 PM.

[Mike DA Spike]

Your English is perfect and much better as my French!
You says, "It doesn't work", do you get any errors ?
Did you import all the flex dmd images into image manager ?
Did you turn off "use externall dmddevice.dll" within pinmame ?
Im not at the cab to check the above code, but I can do it tomorrow

Scutters created a version of Genesis and worked on my cab . I thought it was never released by the author (but can't recall it)

[scutters]

@Citron68

From a glance it looks like you copied most of the code correctly (good effort for a non programmer!).

 

Most obvious things to check / change are;

• As you're copying the code from Logans Run you also need to export the DMD_*** images from that table and import them into Genesis
• For the timer code (when the segment display updates and when the code translates that for flexDMD) you added a new Displaytimer_timer event sub - there is already an event of that name in the table so instead of adding it again you should merge the code into the existing routine.
• Genesis uses 'Genesis' as the table name in the script rather than the usual default Table1 name, so Table1.Filename should be replaced by Genesis.Filename in the script.

There is also some Logans Run specific code left in the script but i don't think that will cause an issue for you.

 

But, i did send the author a copy of the table with flexdmd code added a while ago.. if i still have that copy on dropbox i'll message you a link, that might save you some time (and Mikes too!   )

Edited by scutters, 27 January 2023 - 09:31 PM.

[Citron68]

Thank you to Mike and Scutters for the light explanations.

 

Yes I had export/import DMD images in VPX options.

Yes I had turn off external DMDdevice.dll

 

I think it was a problem with the mixmatch in timercode (but I haven't the know-how)

 

So, when I comeback in front of Pincab, I will try the news.

 

Thank you again the "masters"

[Roadblock]

I really like this option of showing something "nice" on the real DMD.

I wish I was smart enough to make it work.

I've tried to "deconstruct" the Logan's Run table to make Arena work. I get the static display (smaller characters) to show but not the active display (scoring).

I also tried to Excalibur to work with similar results.

If I could figure this out I could get tables like Galaxy Quest to look better on my PinDMD3.

Keep up the good work and please share any other tables modified with this trick.

Thank you masters.

[scutters]

Thanks Roadblock

 

Bigus released a version of Excalibur with flex (see a few posts up) so you should be covered there, and theres a few others i've sent to authors so hopefully will be released in the future. If you post or message me the script you've done for Arena i can have a look at that, but I'll have a look at Galaxy Quest next anyway.

 

 

weisshund's also just released a Black Hole table that has a flex dmd built in, so don't miss that one!!

[Roadblock]

Hi Scutters,

Sorry it was Genesis not Excalibur.

PM coming soon.

Thanks

[scutters]

Galaxy Quest update released by topper2K - https://www.vpforums...&showfile=15147

(i didn't realise there were two versions of the table one with pup pack and one without using different roms, i used the non pup pack version that uses a rom with 6 digit scoring and it won't be compatible with the 7 digit scoring rom used with the pup pack version - sorry!!)

[scutters]

A couple more tables with a flex dmd added;

 

Centaur (Bally MPU AS-2518-35) - https://www.vpforums...&showfile=17078

Star Wars Bad Batch (table mod using Pinstar gamatron rom) - https://vpuniverse.c...-the-bad-batch/

[scutters]

Tom & Jerry (use modded Hollywood Heat rom - Gottlieb System 80B)  DOF V1.2 FlexDMD Addition

 

https://www.vpforums...&showfile=14023

 

Rather than use a 5 pixel wide font (to squeeze 20 characters into a 128x32 display) i tried to use a 6 pixel wide font with touching characters in the display and a slight shadow, the font itself is inspired by the dpcomic comic font. I think it works quite well in the space available.

 

Default external display at top, alternative flexdmd display underneath;

 

 

The table has not been released with the update so you'll need to self update using the zip file here - https://www.dropbox....lexDMD.zip?dl=0

 

Instructions

1. Extract the the files from the zip into a new folder
2. Import ALL the 'DMD-***' images into the Tom and Jerry table (open the table in VPX, then menu options Table -> Image Manager, then click Import and select all the images)
3. Use the TableScript.txt file to either, a) copy and paste to replace the current table script in VPX or b) Rename it as TableName.vbs (where TableName is the exact filename you use for the Tom and Jerry table) and place it in your Visual Pinball\Tables folder.
4. Save the table (do this before any testing - if you don't the imported images will not be available to the script at run time)

And that should be it. 

 

The updated script also includes some extra dip switch menu options (F6) from Mike DA Spike (thanks!)

 

Will the updated script work with other versions of table or with a pup pack? - no idea, but probably not. So don't try these changes to the table script on other versions!

Edited by scutters, 08 March 2023 - 12:30 PM.

[Ltek]

 

Tom & Jerry (use modded Hollywood Heat rom - Gottlieb System 80B)  DOF V1.2 FlexDMD Addition

 

https://www.vpforums...&showfile=14023

 

Rather than use a 5 pixel wide font (to squeeze 20 characters into a 128x32 display) i tried to use a 6 pixel wide font with touching characters in the display and a slight shadow, the font itself is inspired by the dpcomic comic font. I think it works quite well in the space available.

 

Default external display at top, alternative flexdmd display underneath;

 

 

The table has not been released with the update so you'll need to self update using the zip file here - https://www.dropbox....lexDMD.zip?dl=0

 

Instructions

1. Extract the the files from the zip into a new folder
2. Import ALL the 'DMD-***' images into the Tom and Jerry table (open the table in VPX, then menu options Table -> Image Manager, then click Import and select all the images)
3. Use the TableScript.txt file to either, a) copy and paste to replace the current table script in VPX or b) Rename it as TableName.vbs (where TableName is the exact filename you use for the Tom and Jerry table) and place it in your Visual Pinball\Tables folder.
4. Save the table (do this before any testing - if you don't the imported images will not be available to the script at run time)

And that should be it. 

 

The updated script also includes some extra dip switch menu options (F6) from Mike DA Spike (thanks!)

 

Will the updated script work with other versions of table or with a pup pack? - no idea, but probably not. So don't try these changes to the table script on other versions!

 

Tom & Jerry's PuP Pack has a known issue where the DMD will not stay on front. If you can get this working with the PuP; hundreds of people would appreciate you for that!

[wiesshund]

 

Tom & Jerry (use modded Hollywood Heat rom - Gottlieb System 80B)  DOF V1.2 FlexDMD Addition

 

https://www.vpforums...&showfile=14023

 

Rather than use a 5 pixel wide font (to squeeze 20 characters into a 128x32 display) i tried to use a 6 pixel wide font with touching characters in the display and a slight shadow, the font itself is inspired by the dpcomic comic font. I think it works quite well in the space available.

 

Default external display at top, alternative flexdmd display underneath;

 

 

The table has not been released with the update so you'll need to self update using the zip file here - https://www.dropbox....lexDMD.zip?dl=0

 

Instructions

1. Extract the the files from the zip into a new folder
2. Import ALL the 'DMD-***' images into the Tom and Jerry table (open the table in VPX, then menu options Table -> Image Manager, then click Import and select all the images)
3. Use the TableScript.txt file to either, a) copy and paste to replace the current table script in VPX or b) Rename it as TableName.vbs (where TableName is the exact filename you use for the Tom and Jerry table) and place it in your Visual Pinball\Tables folder.
4. Save the table (do this before any testing - if you don't the imported images will not be available to the script at run time)

And that should be it. 

 

The updated script also includes some extra dip switch menu options (F6) from Mike DA Spike (thanks!)

 

Will the updated script work with other versions of table or with a pup pack? - no idea, but probably not. So don't try these changes to the table script on other versions!

 

 

Gap in center of the flexDMD would kind of make text look bad though?
just ignore the DMD below the DMD