thyphoon/LoopzRemix
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
069402c4ec3750c61d1eee5f99618890c0e1645f
LoopzRemix/Database.pbi
Yann Lebrun 069402c4ec Initial commit
2025-07-17 20:36:20 +02:00

327 lines
10 KiB
Plaintext
Raw Blame History

Procedure HallofFamelistToTitle(LastInsertId.l=-1)
Protected String.s
Protected Minutes.l
Protected Seconds.l
Protected Selected.b
Addtitle("Rank"+Chr(9)+" Name"+Chr(9)+"Score"+Chr(9)+"Pieces"+Chr(9)+"Loops"+Chr(9)+"Time",0,128)
ForEach Game\HoF()
String=Str(ListIndex(Game\HoF())+1)
String+Chr(9)+Game\HoF()\Pseudo
String+Chr(9)+Game\HoF()\Score
String+Chr(9)+StrF(ValF(Game\Hof()\PiecesPerMinute),2)+"/Min"
String+Chr(9)+StrF(ValF(Game\Hof()\LoopsPerMinute),2)+"/Min"
Minutes=(Val(Game\Hof()\Duration)/1000)/60
Seconds=(Val(Game\Hof()\Duration)/1000)%60
String+Chr(9)+Str(Minutes)+":"+Str(Seconds)
If Val(Game\HoF()\Id)=LastInsertId
Selected=#True
Else
Selected=#False
EndIf
Addtitle(String,0,255,Selected)
Next
AddTitle("More info on https://loopz.thyphoon.net/",0,255)
Titles\Speed=15000 ; Speed
EndProcedure
;-################
;-Local Database
UseSQLiteDatabase()
#Db=0
Procedure DbError(Sql.s)
MessageRequester("Error", "Can't execute the query:"+Chr(13)+Sql+Chr(13)+Chr(13)+DatabaseError())
EndProcedure
Procedure CheckDatabaseUpdate(Database, Query$)
Protected Result.i
Result = DatabaseUpdate(Database, Query$)
If Result = 0
DbError(Query$)
EndIf
ProcedureReturn Result
EndProcedure
Procedure.s addslashes(txt.s)
txt = ReplaceString(txt, "'", "''")
ProcedureReturn txt
EndProcedure
;Une petite fonction qui manque pour connaitre le dernier ID
Procedure DatabaseLastInsertRowId()
Protected Sql.s
Sql.s = "Select last_insert_rowid()"
If DatabaseQuery(#Db, Sql) = 0
DbError(Sql.s)
ProcedureReturn 0
Else
NextDatabaseRow(#Db)
ProcedureReturn GetDatabaseLong(#Db, 0)
EndIf
EndProcedure
Procedure SaveScoreToLocalDB()
Protected Sql.s
If IsDatabase(#Db)
With Game\ScoreData
Sql.s = "INSERT INTO [Scores] ('Pseudo','Difficulty','Score','Duration','PiecesPerMinute','LoopsPerMinute','AveragePiecesPerLoop','NbLoop'"
sql+",'BigestLoopSize','Bonus_JewelBlue','Bonus_JewelRed','Bonus_JewelGreen','EmptyBench','FPS_Max','FPS_Min','Resolution','Date') VALUES"
Sql+" ('" + addslashes(\Pseudo) + "','" + Str(\Difficulty) + "','" + Str(\Score) + "','" + Str(\Duration) + "','"+StrF(\PiecesPerMinute)+"','"+StrF(\LoopsPerMinute)+"','"+StrF(\AveragePiecesPerLoop)
Sql+"','"+StrF(\NbLoop)+"','"+StrF(\BigestLoopSize)+"','"+StrF(\Bonus_JewelBlue)+"','"+StrF(\Bonus_JewelRed)+"','"+StrF(\Bonus_JewelGreen)+"','"+StrF(\BenchIsEmpty)
Sql+"','"+Str(\Fps_Max)+"','"+Str(\Fps_Min)+"','"+Str(ScreenWidth())+"x"+Str(ScreenHeight())
Sql+"',datetime('now'))"
If DatabaseUpdate(#Db, Sql.s);
Game\LastInsertIdLocal=DatabaseLastInsertRowId()
Debug "LastInsertIdLocal="+Str(Game\LastInsertIdLocal)
Else
DbError(Sql.s)
EndIf
Else
DisplayWarning("SaveScoreToLocalDB() DB not Ready")
EndIf
EndWith
EndProcedure
Procedure LoadHallOfFame(Difficulty.l)
If IsDatabase(#Db)
If DatabaseQuery(#Db, "SELECT Pseudo,Score,PiecesPerMinute,LoopsPerMinute,Duration,Id FROM Scores WHERE Difficulty="+Str(Difficulty)+" order by Score Desc Limit 0,25")
Addtitle("Rank"+Chr(9)+" Name"+Chr(9)+"Score"+Chr(9)+"Pieces"+Chr(9)+"Loops"+Chr(9)+"Time",0,128)
Protected Index.l=0
Protected Minutes.l
Protected Seconds.l
Protected Selected.l
While NextDatabaseRow(#Db) ; Loop for each records
Index=Index+1
Minutes=(GetDatabaseLong(#Db, 4)/1000)/60
Seconds=(GetDatabaseLong(#Db, 4)/1000)%60
If GetDatabaseLong(#Db,5)=Game\LastInsertIdLocal
Selected=#True
Else
Selected=#False
EndIf
Addtitle(Str(Index)+Chr(9)+GetDatabaseString(#Db, 0)+Chr(9)+GetDatabaseString(#Db, 1)+Chr(9)+StrF(GetDatabaseFloat(#Db, 2),2)+"/Min"+Chr(9)+StrF(GetDatabaseFloat(#Db, 3),2)+"/Min"+Chr(9)+Str(Minutes)+":"+Str(Seconds),0,255,Selected)
Wend
FinishDatabaseQuery(#Db)
EndIf
Else
DisplayWarning("LoadHallOfFame() DB not Ready")
EndIf
EndProcedure
;TODO verifier la version de la base de donnée rajouter une table pour les info ou a voir
;TODO Ajouter la saisie du PlayerKey et chargement des scores
Procedure InitDatabase()
If FileSize(GetPDataDirectory(""))<>-2
If CreateDirectory(GetPDataDirectory(""))
Debug "Create Directory"
Else
Debug "ERROR Create Directory"
EndIf
EndIf
Protected DBFileName.s = GetPDataDirectory("HighScore.Dat")
Debug "InitDatabase() "+DBFileName
If FileSize(DBFileName)=-1
Debug "Create DATABASE"
If CreateFile(0,DBFileName)
CloseFile(0)
If OpenDatabase(#Db, DBFileName, "", "", #PB_Database_SQLite) = 0
MessageRequester("Error", "Impossible d'ouvir la base de donnée")
End
ElseIf DatabaseUpdate(#Db, "BEGIN TRANSACTION");
Protected Sql.s
Sql.s="CREATE TABLE [Scores] ("
Sql+"[Id] INTEGER NULL PRIMARY KEY AUTOINCREMENT,"
Sql+"[Pseudo] VARCHAR( 8),"
Sql+"[Difficulty] INTEGER NULL,"
Sql+"[Score] INTEGER NULL,"
Sql+"[Duration] INTEGER NULL,"
Sql+"[PiecesPerMinute] INTEGER NULL,"
Sql+"[LoopsPerMinute] INTEGER NULL,"
Sql+"[AveragePiecesPerLoop] INTEGER NULL,"
Sql+"[NbLoop] INTEGER NULL,"
Sql+"[BigestLoopSize] INTEGER NULL,"
Sql+"[Bonus_JewelBlue] INTEGER NULL,"
Sql+"[Bonus_JewelRed] INTEGER NULL,"
Sql+"[Bonus_JewelGreen] INTEGER NULL,"
Sql+"[EmptyBench] INTEGER NULL,"
Sql+"[Date] Text,"
Sql+"[FPS_Max] INTEGER NULL,"
Sql+"[FPS_Min] INTEGER NULL,"
Sql+"[Resolution] Text NULL"
Sql+")";
Debug Sql
If DatabaseUpdate(#Db,Sql) = 0
DbError(Sql.s)
EndIf
If DatabaseUpdate(#Db, "COMMIT")=0
DbError(Sql.s)
EndIf
EndIf
EndIf
Else
If OpenDatabase(#Db, DBFileName, "", "", #PB_Database_SQLite) = 0
MessageRequester("Error", "Impossible d'ouvir la base de donnée")
End
Else
Debug "DATABASE INIT OK"
If Not DatabaseUpdate(#Db,"Select Bonus_JewelGreen from Scores")
Debug "OLD Database ...i update";
DatabaseUpdate(#Db,"ALTER TABLE [Scores] ADD [AveragePiecesPerLoop] INTEGER NULL")
DatabaseUpdate(#Db,"ALTER TABLE [Scores] ADD [Bonus_JewelGreen] INTEGER NULL")
EndIf
EndIf
EndIf
EndProcedure
;-################
;-Server Database
Procedure.s TalkToServer(Action.s,Json.s)
Protected HttpRequest.i
Protected ClientKey.s="KaLkug1265"
Protected Send.s
Protected Checksum.s
Protected StatusCode.s
Protected reponse.s
NewMap Header$()
;Header$("Content-Type") = "text/plain"
Header$("User-Agent") = "Loopz"
Send.s="Action="+Action
Send+"&Data="+Json
Checksum=StringFingerprint(ClientKey+Json, #PB_Cipher_MD5)
Send+"&CheckSum="+Checksum
Send+"&Version="+#Version
CompilerIf #UsePreProdServer=#True
Send+"&OnlyToTest=0"
CompilerElse
Send+"&OnlyToTest=0"
CompilerEndIf
Debug Send
Debug "Server:"+Game\ServerAddress
HttpRequest = HTTPRequest(#PB_HTTP_Post, Game\ServerAddress, Send,0,Header$())
If HttpRequest
;Debug HTTPInfo(HTTPRequest, #PB_HTTP_Headers)
StatusCode=HTTPInfo(HTTPRequest, #PB_HTTP_StatusCode)
Reponse=HTTPInfo(HTTPRequest, #PB_HTTP_Response)
Debug "StatusCode: " +StatusCode
Debug "Response: " + Reponse
Debug "___"
FinishHTTP(HTTPRequest)
If StatusCode="200"
ProcedureReturn Reponse
EndIf
Else
DisplayWarning("Http Request creation failed")
EndIf
DisplayWarning("Server Error "+Statuscode+Chr(13)+ reponse)
ProcedureReturn ""
EndProcedure
Procedure.s GetAnyValue(Value)
Select JSONType(Value)
Case #PB_JSON_Null: ProcedureReturn "null"
Case #PB_JSON_String: ProcedureReturn GetJSONString(Value)
Case #PB_JSON_Number: ProcedureReturn StrD(GetJSONDouble(Value))
Case #PB_JSON_Boolean: ProcedureReturn Str(GetJSONBoolean(Value))
Case #PB_JSON_Array: ProcedureReturn "array"
Case #PB_JSON_Object: ProcedureReturn "object"
EndSelect
EndProcedure
Procedure SaveScoreToServerDB()
Protected Json.s
Protected Reponse.s
Game\ScoreData\Resolution=GetCurrentResolution()
Game\ScoreData\Os=#CompileVersion
Game\ScoreData\GameVersion=#Version
Game\ScoreData\ComputerName=ComputerName()
Game\ScoreData\UserName=UserName()
If CreateJSON(0)
InsertJSONStructure(JSONValue(0), @Game\ScoreData, ScoreData)
Json=ComposeJSON(0, #PB_JSON_PrettyPrint)
FreeJSON(0)
EndIf
Reponse=TalkToServer("SendScore",Json)
Protected NewMap JsonAnswer()
If Reponse<>""
If ParseJSON(0, Reponse)
If JSONType(JSONValue(0))=#PB_JSON_Object
ExtractJSONMap(JSONValue(0),JsonAnswer())
If FindMapElement(JsonAnswer(),"Id")
Game\LastInsertIdServer=JsonAnswer("Id")
EndIf
If FindMapElement(JsonAnswer(),"Rank")
Debug " Rank="+JsonAnswer("Rank")
EndIf
ProcedureReturn #True
Else
DisplayWarning("ERROR JSON is not Object:"+Chr(13)+Reponse)
ProcedureReturn #False
EndIf
FreeJSON(0)
Else
Debug "JSon Repond From Server:"+JSONErrorMessage()+Chr(13)+Reponse
DisplayWarning("ERROR Can't Parse JSON :"+Chr(13)+Reponse)
ProcedureReturn #False
EndIf
EndIf
EndProcedure
Procedure LoadHallOfFameFromServer(Difficulty.l)
Protected Json.s
Protected Reponse.s
Protected ObjectValue.i
Protected Result.b
ClearList(Game\Hof())
If CreateJSON(0)
ObjectValue = SetJSONObject(JSONValue(0))
SetJSONInteger(AddJSONMember(ObjectValue, "Difficulty"), Difficulty)
SetJSONInteger(AddJSONMember(ObjectValue, "LastInsertId"), Game\LastInsertIdServer)
Debug "LastInsertIDServer="+Str(Game\LastInsertIdServer)
Json=ComposeJSON(0, #PB_JSON_PrettyPrint)
FreeJSON(0)
EndIf
Reponse=TalkToServer("GetHallOfFame",Json)
If reponse<>"" And ParseJSON(0, Reponse)
ObjectValue = JSONValue(0)
;Get HoF
If GetJSONMember(JSONValue(0), "HoF") And JSONType(GetJSONMember(JSONValue(0), "HoF"))=#PB_JSON_Array
ExtractJSONList(GetJSONMember(JSONValue(0) , "HoF"), Game\Hof())
Result=#True
EndIf
;Get Error
Protected Error.s
If GetJSONMember(JSONValue(0), "Error")
Error.s=GetJSONString(GetJSONMember(JSONValue(0), "Error"))
If Error<>""
DisplayWarning("Server ERROR :"+Error)
EndIf
EndIf
FreeJSON(0)
ProcedureReturn Result
Else
DisplayWarning("ERROR Can't Parse JSON :"+Chr(13)+Reponse)
ProcedureReturn #False
EndIf
EndProcedure
; IDE Options = PureBasic 6.12 beta 4 LTS (Windows - x64)
; CursorPosition = 22
; Folding = ---
; EnableXP
Reference in New Issue View Git Blame Copy Permalink