Orbital Scoreboard
VPX Sample Integration
4min
VisualBasic
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' X X X X X X X X X X X X X X X X X X X X X X X
'/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/
' Orbital Scoreboard Code
'\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\
' X X X X X X X X X X X X X X X X X X X X X X X
'****************************
' POST SCORES
'****************************
Dim osbtemp:osbtemp = osbdefinit
Dim osbtempscore:osbtempscore = 0
Sub SubmitOSBScore
On Error Resume Next
if osbactive = 1 or osbactive = 2 Then
Dim objXmlHttpMain, Url, strJSONToSend
Url = "https://hook.integromat.com/82bu988v9grj31vxjklh2e4s6h97rnu0"
strJSONToSend = "{""auth"":""" & osbkey &""",""player id"": """ & osbid & """,""player initials"": """ & osbtemp &""",""score"": " & CStr(osbtempscore) & ",""table"":"""& TableName & """,""version"":""" & myVersion & """}"
Set objXmlHttpMain = CreateObject("Msxml2.ServerXMLHTTP")
objXmlHttpMain.open "PUT",Url, False
objXmlHttpMain.setRequestHeader "Content-Type", "application/json"
objXmlHttpMain.setRequestHeader "application", "application/json"
objXmlHttpMain.send strJSONToSend
end if
End Sub
'****************************
' GET SCORES
'****************************
dim worldscores
Sub GetScores()
if osbkey="" then exit sub
On Error Resume Next
Dim objXmlHttpMain, Url, strJSONToSend
Url = "https://hook.integromat.com/kj765ojs42ac3w4915elqj5b870jrm5c"
strJSONToSend = "{""auth"":"""& osbkey &""", ""table"":"""& TableName & """}"
Set objXmlHttpMain = CreateObject("Msxml2.ServerXMLHTTP")
objXmlHttpMain.open "PUT",Url, False
objXmlHttpMain.setRequestHeader "Content-Type", "application/json"
objXmlHttpMain.setRequestHeader "application", "application/json"
objXmlHttpMain.send strJSONToSend
worldscores = objXmlHttpMain.responseText
vpmtimer.addtimer 3000, "showsuccess '"
debug.print "got the scores"
'debug.print worldscores
splitscores
End Sub
Dim scorevar(22)
Dim dailyvar(22)
Dim weeklyvar(22)
Dim alltimevar(42)
sub emptyscores
dim i
For i = 0 to 42
alltimevar(i) = "0"
Next
For i = 0 to 22
weeklyvar(i) = "0"
dailyvar(i) = "0"
Next
End Sub
emptyscores
Sub splitscores
On Error Resume Next
dim a,scoreset,subset,subit,myNum,daily,weekly,alltime,x
a = Split(worldscores,": {")
subset = Split(a(1),"[")
' debug.print subset(1)
' debug.print subset(2)
' debug.print subset(3)
' daily scores
myNum = 0
daily = Split(subset(1),": ")
for each x in daily
myNum = MyNum + 1
x = Replace(x, vbCr, "")
x = Replace(x, vbLf, "")
x = Replace(x, ",", "")
x = Replace(x, """", "")
x = Replace(x, "{", "")
x = Replace(x, "}", "")
x = Replace(x, "score", "")
x = Replace(x, "initials", "")
x = Replace(x, "weekly", "")
x = Replace(x, "]", "")
x = Replace(x, "alltime", "")
dailyvar(MyNum) = x
if dailyvar(MyNum) = "" Then
if MyNum = 2 or 4 or 6 or 8 or 10 or 12 or 14 or 16 or 18 or 20 Then
dailyvar(MyNum) = "OBS"
Else
dailyvar(MyNum) = 0
end if
end if
debug.print "dailyvar(" &MyNum & ")=" & x
Next
' weekly scores
myNum = 0
weekly = Split(subset(2),": ")
for each x in weekly
myNum = MyNum + 1
x = Replace(x, vbCr, "")
x = Replace(x, vbLf, "")
x = Replace(x, ",", "")
x = Replace(x, """", "")
x = Replace(x, "{", "")
x = Replace(x, "}", "")
x = Replace(x, "score", "")
x = Replace(x, "initials", "")
x = Replace(x, "weekly", "")
x = Replace(x, "]", "")
x = Replace(x, "alltime", "")
weeklyvar(MyNum) = x
if weeklyvar(MyNum) = "" Then
if MyNum = 2 or 4 or 6 or 8 or 10 or 12 or 14 or 16 or 18 or 20 Then
weeklyvar(MyNum) = "OBS"
Else
weeklyvar(MyNum) = 0
end if
end if
debug.print "weeklyvar(" &MyNum & ")=" & x
Next
' alltime scores
myNum = 0
alltime = Split(subset(3),": ")
for each x in alltime
myNum = MyNum + 1
x = Replace(x, vbCr, "")
x = Replace(x, vbLf, "")
x = Replace(x, ",", "")
x = Replace(x, """", "")
x = Replace(x, "{", "")
x = Replace(x, "}", "")
x = Replace(x, "score", "")
x = Replace(x, "initials", "")
x = Replace(x, "weekly", "")
x = Replace(x, "]", "")
x = Replace(x, "alltime", "")
alltimevar(MyNum) = x
if alltimevar(MyNum) = "" Then
if MyNum = 2 or 4 or 6 or 8 or 10 or 12 or 14 or 16 or 18 or 20 or 22 or 24 or 26 or 28 or 30 or 32 or 34 or 36 or 38 or 40 Then
alltimevar(MyNum) = "OBS"
Else
alltimevar(MyNum) = "0"
end if
end if
debug.print "alltimevar(" &MyNum & ")=" & x
Next
end Sub
sub showsuccess
pNote "Scoreboard","Updated"
'pupDMDDisplay "-","Scoreboard^Updated",dmdnote,3,0,10
end sub
GetScores
VisualBasic
Sub CheckHighscore()
Dim tmp
tmp = Score(CurrentPlayer)
osbtempscore = Score(CurrentPlayer)
If tmp > HighScore(3) Then
AwardSpecial
vpmtimer.addtimer 2000, "PlaySound ""vo_contratulationsgreatscore"" '"
HighScore(3) = tmp
'enter player's name
HighScoreEntryInit()
DOF 403, DOFPulse 'DOF MX - Hi Score
Else
osbtemp = osbdefinit
SubmitOSBScore
EndOfBallComplete
End If
End Sub
VisualBasic
Sub HighScoreCommitName()
PuPlayer.playresume 4
playclear pBackglass
PuPlayer.SetLoop 2,0
PuPlayer.playresume 4
playclear pAudio
PuPlayer.SetLoop 7,0
hsEnteredName = hsEnteredDigits(1) & hsEnteredDigits(2) & hsEnteredDigits(3)
HighScoreName(3) = hsEnteredName
checkorder
osbtemp = hsEnteredName
SubmitOSBScore
EndOfBallComplete()
PuPlayer.LabelSet pBackglass,"HighScore","",1,""
PuPlayer.LabelSet pBackglass,"HighScoreL1","",1,""
PuPlayer.LabelSet pBackglass,"HighScoreL2"," ",1,""
PuPlayer.LabelSet pBackglass,"HighScoreL3"," ",1,""
PuPlayer.LabelSet pBackglass,"HighScoreL4"," ",1,""
hsbModeActive = False
End Sub
Updated 25 Mar 2024
Did this page help you?