This commit is contained in:
龙腾猫跃
2023-12-18 04:56:23 +08:00
parent c98e0367d0
commit 6705444fb4
33 changed files with 490 additions and 376 deletions
@@ -577,10 +577,10 @@ Public Module ModAnimation
Public Class AniEaseLinear
Inherits AniEase
Public Overrides Function GetValue(t As Double) As Double
Return MathRange(t, 0, 1)
Return MathClamp(t, 0, 1)
End Function
Public Overrides Function GetDelta(t1 As Double, t0 As Double) As Double
Return MathRange(t1, 0, 1) - MathRange(t0, 0, 1)
Return MathClamp(t1, 0, 1) - MathClamp(t0, 0, 1)
End Function
End Class
@@ -595,7 +595,7 @@ Public Module ModAnimation
p = Power
End Sub
Public Overrides Function GetValue(t As Double) As Double
Return MathRange(t, 0, 1) ^ p
Return MathClamp(t, 0, 1) ^ p
End Function
End Class
''' <summary>
@@ -608,7 +608,7 @@ Public Module ModAnimation
p = Power
End Sub
Public Overrides Function GetValue(t As Double) As Double
Return 1 - MathRange(1 - t, 0, 1) ^ p
Return 1 - MathClamp(1 - t, 0, 1) ^ p
End Function
End Class
''' <summary>
@@ -636,7 +636,7 @@ Public Module ModAnimation
p = 3 - Power * 0.5
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = MathRange(t, 0, 1)
t = MathClamp(t, 0, 1)
Return t ^ p * Math.Cos(1.5 * Math.PI * (1 - t))
End Function
End Class
@@ -650,7 +650,7 @@ Public Module ModAnimation
p = 3 - Power * 0.5
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = MathRange(t, 0, 1)
t = MathClamp(t, 0, 1)
Return 1 - (1 - t) ^ p * Math.Cos(1.5 * Math.PI * t)
End Function
End Class
@@ -694,7 +694,7 @@ Public Module ModAnimation
p = Power + 4
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = MathRange(t, 0, 1)
t = MathClamp(t, 0, 1)
Return t ^ ((p - 1) * 0.25) * Math.Cos((p - 3.5) * Math.PI * (1 - t) ^ 1.5)
End Function
End Class
@@ -708,7 +708,7 @@ Public Module ModAnimation
p = Power + 4
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = 1 - MathRange(t, 0, 1)
t = 1 - MathClamp(t, 0, 1)
Return 1 - t ^ ((p - 1) * 0.25) * Math.Cos((p - 3.5) * Math.PI * (1 - t) ^ 1.5)
End Function
End Class
@@ -766,7 +766,7 @@ Public Module ModAnimation
''' <summary>
''' 开始动画执行。
''' </summary>
Public Sub AniStartRun()
Public Sub AniStart()
'初始化计时器
AniLastTick = GetTimeTick()
AniFPSTimer = AniLastTick
@@ -777,12 +777,12 @@ Public Module ModAnimation
Log("[Animation] 动画线程开始")
Do While True
'两帧之间的间隔时间
Dim DeltaTime As Long = MathRange(GetTimeTick() - AniLastTick, 0, 100000)
Dim DeltaTime As Long = MathClamp(GetTimeTick() - AniLastTick, 0, 100000)
If DeltaTime < 3 Then GoTo Sleeper
AniLastTick = GetTimeTick()
'记录 FPS
If ModeDebug Then
If MathRange(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
AniFPS = AniFPSCounter
AniFPSCounter = 0
AniFPSTimer = AniLastTick
@@ -904,7 +904,7 @@ NextAni:
Case AniTypeSub.Y
DeltaTop(Ani.Obj, Delta)
Case AniTypeSub.Opacity
Ani.Obj.Opacity = MathRange(Ani.Obj.Opacity + Delta, 0, 1)
Ani.Obj.Opacity = MathClamp(Ani.Obj.Opacity + Delta, 0, 1)
Case AniTypeSub.Width
Dim Obj As FrameworkElement = Ani.Obj
Obj.Width = Math.Max(If(Double.IsNaN(Obj.Width), Obj.ActualWidth, Obj.Width) + Delta, 0)
+12 -11
View File
@@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.6.11" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.6.11." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.6.12" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.6.12." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 308 'Release
#Else
Public Const VersionCode As Integer = 309 'Snapshot
Public Const VersionCode As Integer = 310 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -46,7 +46,7 @@ Public Module ModBase
''' <summary>
''' 程序内嵌图片文件夹路径,以“/”结尾。
''' </summary>
Public PathImage As String = "pack://application:,,,/images/"
Public PathImage As String = "pack://application:,,,/Plain Craft Launcher 2;component/Images/"
''' <summary>
''' 当前程序的语言。
''' </summary>
@@ -521,7 +521,6 @@ Public Module ModBase
''' 获取两数间的百分比。小数点精确到 6 位。
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Public Function MathPercent(ValueA As Double, ValueB As Double, Percent As Double) As Double
Return Math.Round(ValueA * (1 - Percent) + ValueB * Percent, 6) '解决 Double 计算错误
End Function
@@ -535,7 +534,7 @@ Public Module ModBase
''' <summary>
''' 将数值限定在某个范围内。
''' </summary>
Public Function MathRange(value As Double, min As Double, max As Double) As Double
Public Function MathClamp(value As Double, min As Double, max As Double) As Double
Return Math.Max(min, Math.Min(max, value))
End Function
@@ -1325,8 +1324,10 @@ Re:
''' <summary>
''' 遍历文件夹中的所有文件。
''' </summary>
Public Function EnumerateFiles(Directory As String) As List(Of FileInfo)
Return New DirectoryInfo(Directory).EnumerateFiles("*", SearchOption.AllDirectories).ToList
Public Function EnumerateFiles(Directory As String) As IEnumerable(Of FileInfo)
Dim Info As New DirectoryInfo(Directory)
If Not Info.Exists Then Return New List(Of FileInfo)
Return Info.EnumerateFiles("*", SearchOption.AllDirectories)
End Function
#End Region
@@ -1456,15 +1457,15 @@ Re:
ElseIf FileSize < 1024 * 1000 Then
'K 级
Dim RoundResult As String = Math.Round(FileSize / 1024)
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024, CInt(MathRange(3 - RoundResult.Length, 0, 2))) & " K"
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024, CInt(MathClamp(3 - RoundResult.Length, 0, 2))) & " K"
ElseIf FileSize < 1024 * 1024 * 1000 Then
'M 级
Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024)
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024, CInt(MathRange(3 - RoundResult.Length, 0, 2))) & " M"
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024, CInt(MathClamp(3 - RoundResult.Length, 0, 2))) & " M"
Else
'G 级
Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024 / 1024)
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024 / 1024, CInt(MathRange(3 - RoundResult.Length, 0, 2))) & " G"
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024 / 1024, CInt(MathClamp(3 - RoundResult.Length, 0, 2))) & " G"
End If
End Function
@@ -634,7 +634,7 @@ Restart:
Next
End SyncLock
If Count = 0 Then Return 1
Return MathRange(Total / Count, 0, 1)
Return MathClamp(Total / Count, 0, 1)
Catch ex As Exception
Log(ex, "获取任务栏进度出错", LogLevel.Feedback)
Return 0.5
@@ -1206,7 +1206,7 @@ SourceBreak:
Info.Source.Ex = ex
'根据情况判断,是否在多线程下禁用下载源(连续错误过多,或不支持断点续传)
If ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("未能解析") OrElse ex.Message.Contains("(404)") OrElse ex.Message.Contains("(403)") OrElse ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse
(Info.Source.FailCount >= MathRange(NetTaskThreadLimit, 5, 40) AndAlso DownloadDone < 1) OrElse
(Info.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 40) AndAlso DownloadDone < 1) OrElse
Info.Source.FailCount > NetTaskThreadLimit Then
Dim IsThisFail As Boolean = False
SyncLock LockSource
@@ -1862,9 +1862,9 @@ Retry:
Dim IsSuccess As Boolean = False
Dim NewThreadCount As Integer
'确定最大线程追加数
NewThreadCount = Math.Max(FileRemain, MathRange(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Max(FileRemain, MathClamp(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
NewThreadCount = MathRange(NewThreadCount, 1, NetTaskThreadLimit)
NewThreadCount = MathClamp(NewThreadCount, 1, NetTaskThreadLimit)
'循环追加
Do
IsSuccess = False
@@ -1919,9 +1919,9 @@ Retry:
Dim IsSuccess As Boolean = False
Dim NewThreadCount As Integer
'确定最大线程追加数
NewThreadCount = Math.Max(FileRemain, MathRange(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Max(FileRemain, MathClamp(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
NewThreadCount = MathRange(NewThreadCount, 1, NetTaskThreadLimit)
NewThreadCount = MathClamp(NewThreadCount, 1, NetTaskThreadLimit)
'循环追加
Do
IsSuccess = False
@@ -54,6 +54,7 @@ Public Class MyBitmap
End Sub
Public Sub New(FilePathOrResourceName As String)
Try
FilePathOrResourceName = FilePathOrResourceName.Replace("pack://application:,,,/images/", PathImage)
If FilePathOrResourceName.StartsWith(PathImage) Then
'使用缓存
If BitmapCache.ContainsKey(FilePathOrResourceName) Then
@@ -536,7 +536,7 @@
End Function
Public Function GetControlLogo() As String
If LogoUrl Is Nothing Then
Return "pack://application:,,,/images/Icons/NoIcon.png"
Return PathImage & "Icons/NoIcon.png"
Else
Return LogoUrl
End If
@@ -1279,13 +1279,13 @@ Retry:
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWith("1.")).
Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", v)).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWith("1.") OrElse v.StartsWith("b1.")).
Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", If(v.StartsWith("b1."), "远古版本", v))).ToList
If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
ElseIf GameVersions.Count = 1 Then
GameVersions = GameVersions.ToList
'无需处理
ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")) Then
GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")).ToList
Else
@@ -1332,11 +1332,11 @@ Retry:
}
Select Case Status
Case CompFileStatus.Release
NewItem.Logo = "pack://application:,,,/images/Icons/R.png"
NewItem.Logo = PathImage & "Icons/R.png"
Case CompFileStatus.Beta
NewItem.Logo = "pack://application:,,,/images/Icons/B.png"
NewItem.Logo = PathImage & "Icons/B.png"
Case Else 'Alpha
NewItem.Logo = "pack://application:,,,/images/Icons/A.png"
NewItem.Logo = PathImage & "Icons/A.png"
End Select
AddHandler NewItem.Click, OnClick
@@ -716,23 +716,23 @@ ExitDataLoad:
If Logo = "" OrElse Not CType(ReadIni(Path & "PCL\Setup.ini", "LogoCustom", False), Boolean) Then
Select Case State
Case McVersionState.Original
Logo = "pack://application:,,,/images/Blocks/Grass.png"
Logo = PathImage & "Blocks/Grass.png"
Case McVersionState.Snapshot
Logo = "pack://application:,,,/images/Blocks/CommandBlock.png"
Logo = PathImage & "Blocks/CommandBlock.png"
Case McVersionState.Old
Logo = "pack://application:,,,/images/Blocks/CobbleStone.png"
Logo = PathImage & "Blocks/CobbleStone.png"
Case McVersionState.Forge
Logo = "pack://application:,,,/images/Blocks/Anvil.png"
Logo = PathImage & "Blocks/Anvil.png"
Case McVersionState.Fabric
Logo = "pack://application:,,,/images/Blocks/Fabric.png"
Logo = PathImage & "Blocks/Fabric.png"
Case McVersionState.OptiFine
Logo = "pack://application:,,,/images/Blocks/GrassPath.png"
Logo = PathImage & "Blocks/GrassPath.png"
Case McVersionState.LiteLoader
Logo = "pack://application:,,,/images/Blocks/Egg.png"
Logo = PathImage & "Blocks/Egg.png"
Case McVersionState.Fool
Logo = "pack://application:,,,/images/Blocks/GoldBlock.png"
Logo = PathImage & "Blocks/GoldBlock.png"
Case Else
Logo = "pack://application:,,,/images/Blocks/RedstoneBlock.png"
Logo = PathImage & "Blocks/RedstoneBlock.png"
End Select
End If
'确定版本描述
@@ -791,7 +791,7 @@ ExitDataLoad:
End If
Catch ex As Exception
Info = "未知错误:" & GetExceptionSummary(ex)
Logo = "pack://application:,,,/images/Blocks/RedstoneBlock.png"
Logo = PathImage & "Blocks/RedstoneBlock.png"
State = McVersionState.Error
Log(ex, "加载版本失败(" & Name & ")", LogLevel.Feedback)
Finally
@@ -24,11 +24,11 @@ Public Module ModMod
End Property
''' <summary>
''' Mod 的完整文件名,去除最后的 .disabled。
''' Mod 的完整文件名,去除最后的 .disabled 和 .old。
''' </summary>
Public ReadOnly Property RawFileName As String
Get
Return FileName.Replace(".disabled", "")
Return FileName.Replace(".disabled", "").Replace(".old", "")
End Get
End Property
@@ -40,7 +40,7 @@ Public Module ModMod
Load()
If Not IsFileAvailable Then
Return McModState.Unavaliable
ElseIf Path.EndsWith(".disabled") Then
ElseIf Path.EndsWith(".disabled") OrElse Path.EndsWith(".old") Then
Return McModState.Disabled
Else
Return McModState.Fine
@@ -365,6 +365,56 @@ Public Module ModMod
Log(ex, "读取 mcmod.info 时出现未知错误(" & Path & ")", LogLevel.Developer)
End Try
#End Region
#Region "尝试使用 fabric.mod.json"
Try
'获取 fabric.mod.json 文件
Dim FabricEntry As ZipArchiveEntry = Jar.GetEntry("fabric.mod.json")
Dim FabricText As String = Nothing
If FabricEntry IsNot Nothing Then
FabricText = ReadFile(FabricEntry.Open(), Encoding.UTF8)
If Not FabricText.Contains("schemaVersion") Then FabricText = Nothing
End If
If FabricText Is Nothing Then Exit Try
Dim FabricObject As JObject = GetJson(FabricText)
GotFabric:
'从文件中获取 Mod 信息项
If FabricObject.ContainsKey("name") Then Name = FabricObject("name")
If FabricObject.ContainsKey("version") Then Version = FabricObject("version")
If FabricObject.ContainsKey("description") Then Description = FabricObject("description")
If FabricObject.ContainsKey("id") Then ModId = FabricObject("id")
If FabricObject.ContainsKey("contact") Then Url = If(FabricObject("contact")("homepage"), "")
Dim AuthorJson As JArray = FabricObject("authors")
If AuthorJson IsNot Nothing Then
Dim Author As New List(Of String)
For Each Token In AuthorJson
Author.Add(Token.ToString)
Next
If Author.Count > 0 Then Authors = Join(Author, ", ")
End If
'If (Not FabricObject.ContainsKey("serverSideOnly")) OrElse FabricObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then
' '添加 Minecraft 依赖
' Dim DepMinecraft As String = If(If(FabricObject("acceptedMinecraftVersions") IsNot Nothing, FabricObject("acceptedMinecraftVersions")("value"), ""), "")
' If DepMinecraft <> "" Then AddDependency("minecraft", DepMinecraft)
' '添加其他依赖
' Dim Deps As String = If(If(FabricObject("dependencies") IsNot Nothing, FabricObject("dependencies")("value"), ""), "")
' If Deps <> "" Then
' For Each Dep In Deps.Split(";")
' If Dep = "" OrElse Not Dep.StartsWith("required-") Then Continue For
' Dep = Dep.Substring(Dep.IndexOf(":") + 1)
' If Dep.Contains("@") Then
' AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
' Else
' AddDependency(Dep)
' End If
' Next
' End If
'End If
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, "读取 fabric.mod.json 时出现未知错误(" & Path & ")", LogLevel.Developer)
End Try
#End Region
#Region "尝试使用 mods.toml"
Try
'获取 mods.toml 文件
@@ -467,56 +517,6 @@ Public Module ModMod
Log(ex, "读取 mods.toml 时出现未知错误(" & Path & ")", LogLevel.Developer)
End Try
#End Region
#Region "尝试使用 fabric.mod.json"
Try
'获取 fabric.mod.json 文件
Dim FabricEntry As ZipArchiveEntry = Jar.GetEntry("fabric.mod.json")
Dim FabricText As String = Nothing
If FabricEntry IsNot Nothing Then
FabricText = ReadFile(FabricEntry.Open(), Encoding.UTF8)
If Not FabricText.Contains("schemaVersion") Then FabricText = Nothing
End If
If FabricText Is Nothing Then Exit Try
Dim FabricObject As JObject = GetJson(FabricText)
GotFabric:
'从文件中获取 Mod 信息项
If FabricObject.ContainsKey("name") Then Name = FabricObject("name")
If FabricObject.ContainsKey("version") Then Version = FabricObject("version")
If FabricObject.ContainsKey("description") Then Description = FabricObject("description")
If FabricObject.ContainsKey("id") Then ModId = FabricObject("id")
If FabricObject.ContainsKey("contact") Then Url = If(FabricObject("contact")("homepage"), "")
Dim AuthorJson As JArray = FabricObject("authors")
If AuthorJson IsNot Nothing Then
Dim Author As New List(Of String)
For Each Token In AuthorJson
Author.Add(Token.ToString)
Next
If Author.Count > 0 Then Authors = Join(Author, ", ")
End If
'If (Not FabricObject.ContainsKey("serverSideOnly")) OrElse FabricObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then
' '添加 Minecraft 依赖
' Dim DepMinecraft As String = If(If(FabricObject("acceptedMinecraftVersions") IsNot Nothing, FabricObject("acceptedMinecraftVersions")("value"), ""), "")
' If DepMinecraft <> "" Then AddDependency("minecraft", DepMinecraft)
' '添加其他依赖
' Dim Deps As String = If(If(FabricObject("dependencies") IsNot Nothing, FabricObject("dependencies")("value"), ""), "")
' If Deps <> "" Then
' For Each Dep In Deps.Split(";")
' If Dep = "" OrElse Not Dep.StartsWith("required-") Then Continue For
' Dep = Dep.Substring(Dep.IndexOf(":") + 1)
' If Dep.Contains("@") Then
' AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
' Else
' AddDependency(Dep)
' End If
' Next
' End If
'End If
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, "读取 fabric.mod.json 时出现未知错误(" & Path & ")", LogLevel.Developer)
End Try
#End Region
#Region "尝试使用 fml_cache_annotation.json"
Try
'获取 fml_cache_annotation.json 文件
@@ -774,7 +774,7 @@ VersionFindFail:
''' 是否可能为前置 Mod。
''' </summary>
Public Function IsPresetMod() As Boolean
Return Dependencies.Count = 0 AndAlso (Name IsNot Nothing) AndAlso (Name.ToLower.Contains("core") OrElse Name.ToLower.Contains("lib"))
Return Dependencies.Count = 0 AndAlso Name IsNot Nothing AndAlso (Name.ToLower.Contains("core") OrElse Name.ToLower.Contains("lib"))
End Function
''' <summary>
@@ -784,7 +784,8 @@ VersionFindFail:
If Path Is Nothing OrElse Not Path.Contains(".") Then Return False
Path = Path.ToLower
If Path.EndsWith(".jar") OrElse Path.EndsWith(".zip") OrElse Path.EndsWith(".litemod") OrElse
Path.EndsWith(".jar.disabled") OrElse Path.EndsWith(".zip.disabled") OrElse Path.EndsWith(".litemod.disabled") Then Return True
Path.EndsWith(".jar.disabled") OrElse Path.EndsWith(".zip.disabled") OrElse Path.EndsWith(".litemod.disabled") OrElse
Path.EndsWith(".jar.old") OrElse Path.EndsWith(".zip.old") OrElse Path.EndsWith(".litemod.old") Then Return True
Return False
End Function
@@ -920,18 +921,19 @@ VersionFindFail:
Log($"[Mod] 从 Modrinth 获取到 {ModrinthUpdate.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If ModrinthUpdate.Count = 0 Then Exit Sub
Dim ModrinthMapping As New Dictionary(Of String, McMod)
Dim ModrinthMapping As New Dictionary(Of String, List(Of McMod))
For Each ModEntity In Mods
If Not ModrinthUpdate.ContainsKey(ModEntity.ModrinthHash) Then Continue For
Dim ProjectId = ModrinthUpdate(ModEntity.ModrinthHash)("project_id").ToString
If CompProjectCache.ContainsKey(ProjectId) Then
ModEntity.Comp = CompProjectCache(ProjectId)
Else
ModrinthMapping.Add(ProjectId, ModEntity)
If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of McMod)
ModrinthMapping(ProjectId).Add(ModEntity)
End If
Next
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Log($"[Mod] 读取缓存后还需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
Log($"[Mod] 读取缓存后还需要从 Modrinth 获取 {ModrinthMapping.Count} 类本地 Mod 的工程信息")
'步骤 3:获取工程信息
If Not ModrinthMapping.Any() Then Exit Sub
Dim ModrinthProject = CType(GetJson(NetRequestRetry(
@@ -939,12 +941,13 @@ VersionFindFail:
"GET", "", "application/json")), JArray)
For Each ProjectJson In ModrinthProject
Dim Project As New CompProject(ProjectJson)
Dim Entry = ModrinthMapping(Project.Id)
If Entry.Comp IsNot Nothing AndAlso Not Entry.IsCompFromModrinth Then
Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 部分 Logo 加载不出来
End If
Entry.IsCompFromModrinth = True
Entry.Comp = Project
For Each Entry In ModrinthMapping(Project.Id)
If Entry.Comp IsNot Nothing AndAlso Not Entry.IsCompFromModrinth Then
Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 部分 Logo 加载不出来
End If
Entry.IsCompFromModrinth = True
Entry.Comp = Project
Next
Next
Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
Catch ex As Exception
@@ -968,16 +971,19 @@ VersionFindFail:
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If CurseForgeRaw.Count = 0 Then Exit Sub
Dim CurseForgeMapping As New Dictionary(Of Integer, McMod)
Dim CurseForgeMapping As New Dictionary(Of Integer, List(Of McMod))
For Each Project In CurseForgeRaw
Dim ProjectId = Project("id").ToString
Dim Hash As UInteger = Project("file")("fileFingerprint")
Dim ModEntity = Mods.Find(Function(m) m.CurseForgeHash = Hash)
If CompProjectCache.ContainsKey(ProjectId) Then
ModEntity.Comp = CompProjectCache(ProjectId)
Else
CurseForgeMapping.Add(ProjectId, ModEntity)
End If
For Each Entry In Mods
If Entry.CurseForgeHash <> Hash Then Continue For
If CompProjectCache.ContainsKey(ProjectId) Then
Entry.Comp = CompProjectCache(ProjectId)
Else
If Not CurseForgeMapping.ContainsKey(ProjectId) Then CurseForgeMapping(ProjectId) = New List(Of McMod)
CurseForgeMapping(ProjectId).Add(Entry)
End If
Next
Next
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Log($"[Mod] 读取缓存后还需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
@@ -987,14 +993,15 @@ VersionFindFail:
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
For Each ProjectJson In CurseForgeProject
Dim Project As New CompProject(ProjectJson)
Dim Entry = CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
If Entry.Comp IsNot Nothing AndAlso Entry.IsCompFromModrinth Then
Entry.Comp.LogoUrl = Project.LogoUrl 'Modrinth 部分 Logo 加载不出来
Entry.Comp = Entry.Comp '再次触发修改事件
Continue For
End If
Entry.IsCompFromModrinth = False
Entry.Comp = Project
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
If Entry.Comp IsNot Nothing AndAlso Entry.IsCompFromModrinth Then
Entry.Comp.LogoUrl = Project.LogoUrl 'Modrinth 部分 Logo 加载不出来
Entry.Comp = Entry.Comp '再次触发修改事件
Continue For
End If
Entry.IsCompFromModrinth = False
Entry.Comp = Project
Next
Next
Log($"[Mod] 从 CurseForge 获取本地 Mod 信息结束")
Catch ex As Exception
@@ -20,9 +20,9 @@
PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.ToLower.EndsWith(".webp") Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[Comp] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else
PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
End If
Else
@@ -77,7 +77,7 @@ RetryStart:
GoTo RetryStart
Else
Log(ex, $"下载资源工程图标失败({_Logo})")
RunInUi(Sub() PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png"))
RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png"))
End If
End Try
End Sub
@@ -172,19 +172,24 @@ RetryStart:
FrmMain.PageCurrent.Additional(1) = Titles
End If
'打开详情页
Dim TargetVersion As String, TargetLoader As CompModLoaderType
Select Case CType(sender.Tag, CompProject).Type
Case CompType.Mod
TargetVersion = If(PageDownloadMod.Loader.Input.GameVersion, "")
Case CompType.ModPack
TargetVersion = If(PageDownloadPack.Loader.Input.GameVersion, "")
Case Else 'CompType.ResourcePack
'FUTURE: Res
TargetVersion = "" 'If(PageDownloadResource.Loader.Input.GameVersion, "")
End Select
If CType(sender.Tag, CompProject).Type = CompType.Mod AndAlso PageDownloadMod.Loader.Input.ModLoader <> CompModLoaderType.Any Then
TargetLoader = PageDownloadMod.Loader.Input.ModLoader
Dim TargetVersion As String
Dim TargetLoader As CompModLoaderType
If FrmMain.PageCurrent.Page = FormMain.PageType.CompDetail Then
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
Else
Select Case CType(sender.Tag, CompProject).Type
Case CompType.Mod
TargetVersion = If(PageDownloadMod.Loader.Input.GameVersion, "")
TargetLoader = PageDownloadMod.Loader.Input.ModLoader
Case CompType.ModPack
TargetVersion = If(PageDownloadPack.Loader.Input.GameVersion, "")
Case Else 'CompType.ResourcePack
'FUTURE: Res
TargetVersion = "" 'If(PageDownloadResource.Loader.Input.GameVersion, "")
End Select
End If
If CType(sender.Tag, CompProject).Type <> CompType.Mod Then TargetLoader = CompModLoaderType.Any
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail,
.Additional = {sender.Tag, New List(Of String), TargetVersion, TargetLoader}})
End Sub
@@ -28,7 +28,7 @@
<!-- 标题 -->
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" Foreground="{Binding Foreground, ElementName=PanBack}" />
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
</StackPanel>
<!-- Tag 与 详情 -->
@@ -22,9 +22,9 @@ Public Class MyLocalModItem
PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.ToLower.EndsWith(".webp") Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[LocalModItem] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else
PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
End If
Else
@@ -79,7 +79,7 @@ RetryStart:
GoTo RetryStart
Else
Log(ex, $"下载本地 Mod 图标失败({_Logo})")
RunInUi(Sub() PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png"))
RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png"))
End If
End Try
End Sub
@@ -93,9 +93,12 @@ RetryStart:
Set(value As String)
Dim RawValue = value
Select Case Entry.State
Case McMod.McModState.Fine
LabTitle.TextDecorations = Nothing
Case McMod.McModState.Disabled
value &= " [禁用]"
LabTitle.TextDecorations = TextDecorations.Strikethrough
Case McMod.McModState.Unavaliable
LabTitle.TextDecorations = TextDecorations.Strikethrough
value &= " [错误]"
End Select
If LabTitle.Text = value Then Exit Property
@@ -154,17 +157,6 @@ RetryStart:
End Set
End Property
'前景色绑定
Public Property Foreground As Brush
Get
Return GetValue(ForegroundProperty)
End Get
Set(value As Brush)
SetValue(ForegroundProperty, value)
End Set
End Property
Public Shared ReadOnly ForegroundProperty As DependencyProperty = DependencyProperty.Register("Foreground", GetType(Brush), GetType(MyLocalModItem), New PropertyMetadata(CType(Color1, SolidColorBrush)))
#End Region
#Region "点击与勾选"
@@ -229,13 +221,13 @@ RetryStart:
Anim.Add(AaOpacity(RectCheck, 1 - RectCheck.Opacity, 30))
RectCheck.VerticalAlignment = VerticalAlignment.Center
RectCheck.Margin = New Thickness(-3, 0, 0, 0)
Anim.Add(AaColor(Me, ForegroundProperty, "ColorBrush2", 200))
Anim.Add(AaColor(LabTitle, TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"), 200))
Else
'由有变无
Anim.Add(AaHeight(RectCheck, -RectCheck.ActualHeight, 120,, New AniEaseInFluent(AniEasePower.Weak)))
Anim.Add(AaOpacity(RectCheck, -RectCheck.Opacity, 70, 40))
RectCheck.VerticalAlignment = VerticalAlignment.Center
Anim.Add(AaColor(Me, ForegroundProperty, "ColorBrush1", 120))
Anim.Add(AaColor(LabTitle, TextBlock.ForegroundProperty, If(LabTitle.TextDecorations Is Nothing, "ColorBrush1", "ColorBrushGray4"), 120))
End If
AniStart(Anim, "MyLocalModItem Checked " & Uuid)
Else
@@ -245,23 +237,19 @@ RetryStart:
If Checked Then
RectCheck.Height = 32
RectCheck.Opacity = 1
Foreground = CType(FindResource("ColorBrush2"), SolidColorBrush)
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
RectCheck.Height = 0
RectCheck.Opacity = 0
Foreground = CType(FindResource("ColorBrush1"), SolidColorBrush)
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
AniStop("MyLocalModItem Checked " & Uuid)
End If
Catch ex As Exception
Log(ex, "设置 Checked 失败")
End Try
End Set
End Property
Private Sub ColorInit(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
SetResourceReference(ForegroundProperty, "ColorBrush1")
End Sub
#End Region
@@ -361,13 +349,18 @@ RetryStart:
Title = Titles.Key
SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version)
End If
If Checked Then
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
'描述
Dim NewDescription As String
Select Case Entry.State
Case McMod.McModState.Fine
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path)
Case McMod.McModState.Disabled
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path.Substring(0, Entry.Path.Count - ".disabled".Count))
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", ""))
Case Else 'McMod.McModState.Unavaliable
NewDescription = GetFileNameFromPath(Entry.Path)
End Select
@@ -380,7 +373,7 @@ RetryStart:
End If
Description = NewDescription
'主 Logo
Logo = If(Entry.Comp Is Nothing, "pack://application:,,,/images/Icons/NoIcon.png", Entry.Comp.GetControlLogo())
Logo = If(Entry.Comp Is Nothing, PathImage & "Icons/NoIcon.png", Entry.Comp.GetControlLogo())
'图标右下角的 Logo
If Entry.State = McMod.McModState.Fine Then
If ImgState IsNot Nothing Then
@@ -390,7 +383,7 @@ RetryStart:
Else
If ImgState Is Nothing Then
ImgState = New Image With {
.Width = 17, .Height = 17, .Margin = New Thickness(0, 0, -4, -3), .IsHitTestVisible = False,
.Width = 20, .Height = 20, .Margin = New Thickness(0, 0, -5, -3), .IsHitTestVisible = False,
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Bottom
}
RenderOptions.SetBitmapScalingMode(ImgState, BitmapScalingMode.HighQuality)
@@ -401,7 +394,7 @@ RetryStart:
' HorizontalAlignment="Right" VerticalAlignment="Bottom"
' Source="/Images/Icons/Unavaliable.png" />
End If
ImgState.Source = New MyBitmap($"pack://application:,,,/images/Icons/{Entry.State}.png")
ImgState.Source = New MyBitmap(PathImage & $"Icons/{Entry.State}.png")
End If
'标签
If Entry.Comp IsNot Nothing Then Tags = Entry.Comp.Tags
+4 -5
View File
@@ -22,12 +22,11 @@
If MusicAllList Is Nothing Then
MusicAllList = New List(Of String)
Directory.CreateDirectory(Path & "PCL\Musics\")
For Each File In My.Computer.FileSystem.GetFiles(Path & "PCL\Musics\", FileIO.SearchOption.SearchAllSubDirectories, "*.*")
For Each File In EnumerateFiles(Path & "PCL\Musics\")
'文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的
Dim Extend As String = File.Split(".").Last.ToLower
If Not (Extend = "ini" OrElse Extend = "jpg" OrElse Extend = "txt" OrElse Extend = "cfg" OrElse Extend = "lrc" OrElse Extend = "db" OrElse Extend = "png") Then
MusicAllList.Add(File)
End If
Dim Ext As String = File.Extension.ToLower
If {"ini", "jpg", "txt", "cfg", "lrc", "db", "png"}.Contains(Ext) Then Continue For
MusicAllList.Add(File.FullName)
Next
End If
'打乱顺序播放