Option Explicit Const SoundToggle=TRUE LoadVPM "01540000","SEGA.VBS",3.10 Sub LoadVPM(VPMver,VBSfile,VBSver) On Error Resume Next If ScriptEngineMajorVersion<5 Then MsgBox"VB Script Engine 5.0 or higher required" ExecuteGlobal GetTextFile(VBSfile) If Err Then MsgBox"Unable to open "&VBSfile&". Ensure that it is in the same folder as this table."&vbNewLine&Err.Description:Err.Clear Set Controller=CreateObject("VPinMAME.Controller") If Err Then MsgBox"Can't Load VPinMAME."&vbNewLine&Err.Description If VPMver>"" Then If Controller.Version0 Then BalrogFrame=BalrogFrame-1 'L57.State=Controller.Lamp(57) balrogupdate Else BalrogClose.Enabled=0 End If End Sub Sub BSL(Enabled) If Enabled Then Kicker2.Kick 75,14,1.3613574000000001'78 degrees Controller.Switch(9)=0 End If End Sub Sub Kicker2_Hit:Controller.Switch(9)=1:End Sub 'switch 9 Sub Wall2_Hit:vpmTimer.PulseSw 10:End Sub 'switch 10 Sub Drain_Hit bsTrough.AddBall Me End Sub 'switch 11/12/13/14/15 Sub Trigger5_Hit:Controller.Switch(16)=1:End Sub 'switch 16 Sub Trigger5_unHit:Controller.Switch(16)=0:End Sub Sub Trigger15_Hit:Controller.Switch(20)=1:End Sub 'switch 20 Sub Trigger15_unHit:Controller.Switch(20)=0:End Sub Sub Trigger16_Hit:Controller.Switch(21)=1:End Sub 'switch 21 Sub Trigger16_unHit:Controller.Switch(21)=0:End Sub Sub Wall31_Hit:vpmTimer.PulseSw 23:End Sub 'switch 23 Sub Trigger14_Hit:Controller.Switch(24)=1:End Sub 'switch 24 Sub Trigger14_unHit:Controller.Switch(24)=0:End Sub Sub Trigger13_Hit:Controller.Switch(25)=1:End Sub 'switch 25 Sub Trigger13_unHit:Controller.Switch(25)=0:End Sub Sub BRG_Hit:vpmTimer.PulseSw 28:End Sub 'switch 28 Sub Wall6_Hit:vpmTimer.PulseSw 29:End Sub 'switch 29 Dim CKBalls CKBalls=0 Dim MY Sub Kicker1_Hit 'switch 30 MY=ActiveBall.VelY If MY>-8 And MY<8 Then CKBalls=1 Controller.Switch(30)=1 Exit Sub End If Me.Kick 180,MY/2 End Sub Sub Trigger8_Hit:StopSound"FCEC":StopSound"FCED":StopSound"FCEE":Controller.Switch(33)=1:End Sub'switch 33 Sub Trigger8_unHit:Controller.Switch(33)=0:End Sub Sub Trigger9_Hit:StopSound"FCEC":StopSound"FCED":StopSound"FCEE":Controller.Switch(34)=1:End Sub'switch 34 Sub Trigger9_unHit:Controller.Switch(34)=0:End Sub Sub Trigger6_Hit:StopSound"FCEC":StopSound"FCED":StopSound"FCEE":Controller.Switch(35)=1:End Sub'switch 35 Sub Trigger6_unHit:Controller.Switch(35)=0:End Sub Sub Trigger7_Hit:StopSound"FCEC":StopSound"FCED":StopSound"FCEE":Controller.Switch(36)=1:End Sub'switch 36 Sub Trigger7_unHit:Controller.Switch(36)=0:End Sub Sub Trigger1_Hit:Controller.Switch(37)=1:End Sub 'switch 37 Sub Trigger1_unHit:Controller.Switch(37)=0:End Sub Sub Trigger10_Hit:Controller.Switch(38)=1:End Sub 'switch 38 Sub Trigger10_unHit:Controller.Switch(38)=0:End Sub Sub Trigger11_Hit:Controller.Switch(39)=1:End Sub 'switch 39 Sub Trigger11_unHit:Controller.Switch(39)=0:End Sub Sub Trigger21_Hit:Controller.Switch(40)=1:End Sub 'switch 40 Sub Trigger21_unHit:Controller.Switch(40)=0:End Sub Sub Kicker4_Hit:bsTLVUK.AddBall Me:End Sub 'switch 41 Sub Kicker5_Hit:bsTLVUK.AddBall Me:End Sub Sub Kicker6_Hit:bsTLVUK.AddBall Me:End Sub Sub Kicker13_Hit:bsTLVUK.AddBall Me:End Sub Sub Kicker14_Hit:bsTLVUK.AddBall Me:End Sub Sub Kicker15_Hit:bsTLVUK.AddBall Me:End Sub Sub Trigger17_Hit:Controller.Switch(42)=1:End Sub 'switch 42 Sub Trigger17_unHit:Controller.Switch(42)=0:End Sub Sub Trigger2_Hit:Controller.Switch(43)=1:End Sub 'switch 43 Sub Trigger2_unHit:Controller.Switch(43)=0:End Sub Sub Trigger3_Hit:Controller.Switch(44)=1:End Sub 'switch 44 Sub Trigger3_unHit:Controller.Switch(44)=0:End Sub Sub Trigger4_Hit:Controller.Switch(45)=1:End Sub 'switch 45 Sub Trigger4_unHit:Controller.Switch(45)=0:End Sub Sub Kicker3_Hit:bsTopSaucer.AddBall 0:End Sub 'switch 46 Sub RingMag_Hit Controller.Switch(47)=1 Set RBall=ActiveBall mRingMagnet.AddBall RBall mRingMagnet.AttractBall RBall RingBlock.IsDropped=0 End Sub Sub RingMag_unHit Controller.Switch(47)=0 mRingMagnet.RemoveBall RBall RingBlock.IsDropped=1 End Sub Dim RBall Sub SolRM(Enabled) If Enabled Then mRingMagnet.MagnetOn=True Else mRingMagnet.MagnetOn=False If UBound(mRingMagnet.Balls)>0 Then RBall.VelX=6 RBall.VelY=-3 End If End If End Sub Sub RingBlock_Hit mRingMagnet.MagnetOn=False RingBlock.IsDropped=1 If UBound(mRingMagnet.Balls)>0 Then RBall.VelX=6 RBall.VelY=-3 End If End Sub Sub Trigger27_Hit:Controller.Switch(48)=1:End Sub '48=Back Trough Sub Trigger27_Unhit:Controller.Switch(48)=0:End Sub Sub Bumper3_Hit:vpmTimer.PulseSw 49:End Sub 'switch 49 Sub Bumper2_Hit:vpmTimer.PulseSw 50:End Sub 'switch 50 Sub Bumper1_Hit:vpmTimer.PulseSw 51:End Sub 'switch 51 Sub Spinner1_Spin:vpmTimer.PulseSw 52:End Sub 'switch 52 Sub Wall66_Hit:vpmTimer.PulseSw 53:End Sub 'switch 53 Sub LeftOutlane_Hit:Controller.Switch(57)=1:End Sub 'switch 57 Sub LeftOutlane_unHit:Controller.Switch(57)=0:End Sub Sub LeftInlane_Hit:Controller.Switch(58)=1:End Sub 'switch 58 Sub LeftInlane_unHit:Controller.Switch(58)=0:End Sub Sub LeftSlingshot_Slingshot:vpmTimer.PulseSw 59:End Sub 'switch 59 Sub RightOutlane_Hit:Controller.Switch(60)=1:End Sub 'switch 60 Sub RightOutlane_unHit:Controller.Switch(60)=0:End Sub Sub RightInlane_Hit:Controller.Switch(61)=1:End Sub 'switch 61 Sub RightInlane_unHit:Controller.Switch(61)=0:End Sub Sub RightSlingshot_Slingshot:vpmTimer.PulseSw 62:End Sub 'switch 62 Sub Trigger22_Hit: If Activeball.VelX>0 And Activeball.VelX<12 Then: Activeball.VelX=-Activeball.VelX End If: End Sub Sub Trigger23_Hit: If Activeball.VelY>0 And Activeball.VelY<12 Then: Activeball.VelY=-Activeball.VelY End If: End Sub Sub Trigger24_Hit: If Activeball.VelY<0 And Activeball.VelY>-12 Then: Activeball.VelY=-Activeball.VelY End If: End Sub Sub Trigger25_Hit:Activeball.VelY=2:End Sub 'SWORD LOCK CODE Dim LockBalls,LockRelease,MA1,MA2,MA3,MA1X,MA1Y,MA2X,MA2Y,MA3X,MA3Y LockBalls=0:LockRelease=0 Sub SolLockRelease(Enabled) If Enabled Then LockRelease=1 LockPost.IsDropped=1 KA.Kick 180,0 KB.Kick 180,0 KC.Kick 180,0 End If End Sub Sub Trigger12_Hit:Controller.Switch(22)=1:End Sub Sub Trigger12_unHit:Controller.Switch(22)=0:End Sub Sub Trigger18_Hit:LockBalls=LockBalls+1:End Sub Sub Trigger19_Hit:LockBalls=LockBalls+1:End Sub Sub KC_Hit Set MA3=ActiveBall MA3X=MA3.VelX MA3Y=MA3.VelY If LockBalls<3 Then Me.Kick 180,0 MA3.VelX=MA3X MA3.VelY=MA3Y End Sub Sub KB_Hit Set MA2=ActiveBall MA2X=MA2.VelX MA2Y=MA2.VelY If LockBalls<2 Then Me.Kick 180,0 MA2.VelX=MA2X MA2.VelY=MA2Y End Sub Sub KA_Hit Set MA1=ActiveBall MA1X=MA1.VelX MA1Y=MA1.VelY If LockRelease=1 Then Me.Kick 180,0 MA1.VelX=MA1X MA1.VelY=MA1Y LockRelease=0 End If End Sub Sub T18_Hit:Controller.Switch(17)=1:End Sub Sub T18_unHit:Controller.Switch(17)=0:End Sub Sub T19_Hit:Controller.Switch(18)=1:End Sub Sub T19_unHit:Controller.Switch(18)=0:End Sub Sub T20_Hit:Controller.Switch(19)=1:End Sub Sub T20_unHit:Controller.Switch(19)=0:End Sub Sub Trigger26_Hit If Not Trigger26.TimerEnabled Then LockBalls=LockBalls-1 Trigger26.TimerEnabled=1 End If LockRelease=0 LockPost.IsDropped=0 End Sub Sub Trigger26_Timer Me.TimerEnabled=0 End Sub 'TOWER ANIMATION Dim TowerFrame,TowerDirection TowerFrame=0:TowerDirection=1 Sub SolTower(Enabled) If Enabled Then TowerDirection=1 Else TowerDirection=0 End If EMReel3_Timer EMReel3.TimerEnabled=0 EMReel3.TimerEnabled=1 End Sub Sub EMReel3_Timer If TowerDirection=1 Then If TowerFrame<5 Then TowerFrame=TowerFrame+1 EMREEL3.SetValue TowerFrame If TowerFrame=5 Then EMReel3.TimerEnabled=0 End If If TowerDirection=0 Then If TowerFrame>0 Then TowerFrame=TowerFrame-1 EMREEL3.SetValue TowerFrame If TowerFrame=0 Then EMReel3.TimerEnabled=0 End If End Sub 'RIGHT FLASHER Dim RFCount,RFDir RFCount=0:RFDir=1 Sub SolRightFlasher(Enabled) If Enabled Then RFDir=1 If RFCount<4 Then RFCount=RFCount+1 Else RFDir=0 If RFCount>0 Then RFCount=RFCount-1 End If EMReel4.SetValue RFCount EMReel4.TimerEnabled=0 EMReel4.TimerEnabled=1 End Sub Sub EMReel4_Timer If RFDir=1 Then If RFCount<4 Then RFCount=RFCount+1 Else EMReel4.TimerEnabled=0 End If Else If RFCount>0 Then RFCount=RFCount-1 Else EMReel4.TimerEnabled=0 End If End If EMReel4.SetValue RFCount End Sub Dim LS,RS LS=0:RS=0 Sub SolLS(Enabled) If Enabled Then LS=1 Else LS=0 End If EMReel1.SetValue 1 EMReel1.TimerEnabled=0 EMReel1.TimerEnabled=1 End Sub Sub EMReel1_Timer EMReel1.TimerEnabled=0 If LS=1 Then EMReel1.SetValue 2 Else EMReel1.SetValue 0 End If End Sub Sub SolRS(Enabled) If Enabled Then RS=1 Else RS=0 End If EMReel2.SetValue 1 EMReel2.TimerEnabled=0 EMReel2.TimerEnabled=1 End Sub Sub EMReel2_Timer EMReel2.TimerEnabled=0 If RS=1 Then EMReel2.SetValue 2 Else EMReel2.SetValue 0 End If End Sub Dim LSB,RSB,SpinLB,SpinRB,SpinFrame,SpinDir,SpinCount,TimeDuration,SpinVelocity SpinFrame=16:SpinDir=1:TimeDuration=0:SpinVelocity=0 SpinLB=Array("SL1F","SL2F","SL3F","SL4F","SL5F","SL6F","SL7F","SL8F","SL9F","SL10F","SL11F","SL12F","SL13F","SL14F","SL15F","SL16F","SL17F",_ "SL16F","SL15F","SL14F","SL13F","SL12F","SL11F","SL10F","SL9F","SL8F","SL7F","SL6F","SL5F","SL4F","SL3F","SL2F") SpinRB=Array("SR1F","SR2F","SR3F","SR4F","SR5F","SR6F","SR7F","SR8F","SR9F","SR10F","SR11F","SR12F","SR13F","SR14F","SR15F","SR16F","SR17F",_ "SR16F","SR15F","SR14F","SR13F","SR12F","SR11F","SR10F","SR9F","SR8F","SR7F","SR6F","SR5F","SR4F","SR3F","SR2F") Sub Trigger28_Hit If ActiveBall.VelY<-20 Then ActiveBall.VelY=-20 If ActiveBall.VelY<0 And SpinFrame<>8 And SpinFrame<>24 Then 'If ball hits spinner going to back of table, get speed and set direction SpinVelocity=ABS(SpinVelocity+SQR(ActiveBall.VelY*ActiveBall.VelY+ActiveBall.VelX*ActiveBall.VelX)) SpinDir=1 End If If ActiveBall.VelY>0 And SpinFrame<>8 And SpinFrame<>24 Then 'If ball hits spinner going to front of table, get speed and set direction SpinVelocity=ABS(SpinVelocity-SQR(ActiveBall.VelY*ActiveBall.VelY+ActiveBall.VelX*ActiveBall.VelX)) SpinDir=-1 End If TimeDuration=INT(50/ABS(SpinVelocity)) 'ensure timer interval duration is NOT negative SUpdate.Interval=TimeDuration 'Set Start of Spin Timer Interval SUpdate.Enabled=0 'disable animation timer count SUpdate.Enabled=1 'enabled animation timer count SUpdate_Timer 'update timer immediately - spinner has been hit End Sub Dim SpinFriction SpinFriction=0 Sub SUpdate_Timer If SpinFrame=0 Then SpinFriction=.2 If SpinFrame=16 Then SpinFriction=-.25 SpinVelocity=SpinVelocity+SpinFriction Routine If SpinVelocity<1 And SpinVelocity>-1 Then If SpinFrame=16 Then SUpdate.Enabled=0 LSB.Image=SpinLB(SpinFrame) RSB.Image=SpinRB(SpinFrame) Exit Sub End If 'Stop spinner and exit End If If SpinVelocity>0 Then TimeDuration=INT(50/ABS(SpinVelocity)) 'ensure timer interval duration is NOT negative If TimeDuration>30 Then TimeDuration=30'minimum range of motion for movement SUpdate.Interval=TimeDuration 'Set Start of Spin Timer Interval SUpdate.Enabled=0'disable timer to kill current iteration time frame SUpdate.Enabled=1'enable timer to start new iteration time frame 'ok, physics done, toss up new image SpinFrame=SpinFrame+SpinDir If SpinFrame>31 Then SpinFrame=0:End If If SpinFrame<0 Then SpinFrame=31:End If ' If SpinFrame=0 Then End If 'Pulse Spin Switch (weight at top) LSB.Image=SpinLB(SpinFrame) RSB.Image=SpinRB(SpinFrame) End Sub Sub Routine If SpinVelocity<4 Then If SpinFrame=18 And SpinDir=1 Then SpinDir=-SpinDir If SpinFrame=15 And SpinDir=-1 Then SpinDir=-SpinDir Exit Sub End If If SpinVelocity<7 Then If SpinFrame=20 And SpinDir=1 Then SpinDir=-SpinDir If SpinFrame=13 And SpinDir=-1 Then SpinDir=-SpinDir Exit Sub End If If SpinVelocity<10 Then If SpinFrame=22 And SpinDir=1 Then SpinDir=-SpinDir If SpinFrame=11 And SpinDir=-1 Then SpinDir=-SpinDir Exit Sub End If If SpinVelocity<13 Then If SpinFrame=24 And SpinDir=1 Then SpinDir=-SpinDir If SpinFrame=9 And SpinDir=-1 Then SpinDir=-SpinDir Exit Sub End If End Sub Dim Playing Playing=0 If SoundToggle=True Then Set MotorCallback=GetRef("TrackSounds") End If 'Music & Sound Stuff Sub TrackSounds Dim NewSounds, ii, Snd NewSounds = Controller.NewSoundCommands If Not IsEmpty(NewSounds) Then For ii = 0 To UBound(NewSounds) Snd = NewSounds(ii,0) If Snd=254 Then Playing=3'FE If Snd=253 Then Playing=2'FD If Snd=252 Then Playing=1'FC If Snd <> 38 And Snd <> 255 And Snd <> 1 And Snd<>0 And Snd<>16 Then SoundCommand(Snd) Next End If End Sub Sub SoundCommand(Cmd) Dim SndName If Playing=3 Then SndName="FE" If Playing=2 Then SndName="FD" If Playing=1 Then SndName="FC" If Playing=2 And Cmd < 40 And Cmd<>5 And Cmd<>31 Then 'Ignore FD1F - unknown command, FD5 handled after FD4 is played MusicCommand(Cmd) Else Dim FinalSnd FinalSnd=HEX(Cmd) SndName = SndName & FinalSnd If SndName="FD5" Then StopSound"FD4" PlaySound SndName End If End Sub Dim LastMus LastMus=" " Sub MusicCommand(Cmd) SevTimer.Enabled=0 If Len(LastMus) > 0 Or Cmd = 0 Then StopSound LastMus Dim FinalMus FinalMus=Hex(Cmd) LastMus = "FD" & FinalMus If Cmd=7 Then LastMus="FD07A" SevTimer.Enabled=1 PlaySound "FD07A" Exit Sub End If PlaySound LastMus,-1 End Sub Sub SevTimer_Timer LastMus="FD07B" PlaySound LastMus,-1 SevTimer.Enabled=0 End Sub Sub Wall161_Slingshot:ActiveBall.VelX=10:End Sub Sub Trigger30_Hit:ActiveBall.VelZ=0:End Sub sub balrogupdate balroga.setvalue abs(balrogframe>0)+abs(balrogframe=5)+3*SFB+6*Odiv balrogb.setvalue balrogframe+6*SFB balrogc.setvalue balrogframe+5*PFA End Sub