This repository has been archived by the owner on Jul 28, 2022. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 0
/
ModMain.vb
337 lines (331 loc) · 15.6 KB
/
ModMain.vb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
Imports System.Text
Public Module ModMain
'对 TextBlock 设置富文本
Public Sub SetText(Target As TextBlock, RawText As String)
RawText = RawText.Replace("\n", vbCrLf)
'将文本按颜色分段，保证每段开头均为颜色标记
If Not RawText.StartsWith("\") Then RawText = "WHITE" & RawText
Dim RawTexts As String() = RawText.Split("\")
'修改目标显示
Target.Inlines.Clear()
For Each Inline In RawTexts
If Inline = "" Then Continue For
Dim TargetColor As MyColor
Dim Delta As Integer = 0
If Inline.StartsWith("WHITE") Then
TargetColor = New MyColor(255, 255, 255)
Delta = 5
ElseIf Inline.StartsWith("AQUA") Then
TargetColor = New MyColor(0, 255, 255)
Delta = 4
ElseIf Inline.StartsWith("RED") Then
TargetColor = New MyColor(255, 0, 0)
Delta = 3
ElseIf Inline.StartsWith("ORANGE") Then
TargetColor = New MyColor(255, 128, 0)
Delta = 6
ElseIf Inline.StartsWith("DIMRED") Then
TargetColor = New MyColor(170, 0, 0)
Delta = 6
ElseIf Inline.StartsWith("DARKRED") Then
TargetColor = New MyColor(100, 0, 0)
Delta = 7
ElseIf Inline.StartsWith("YELLOW") Then
TargetColor = New MyColor(255, 255, 0)
Delta = 6
ElseIf Inline.StartsWith("GREEN") Then
TargetColor = New MyColor(0, 255, 0)
Delta = 5
ElseIf Inline.StartsWith("DARKBLUE") Then
TargetColor = New MyColor(0, 0, 150)
Delta = 8
ElseIf Inline.StartsWith("BLUE") Then
TargetColor = New MyColor(0, 0, 255)
Delta = 4
ElseIf Inline.StartsWith("GRAY") Then
TargetColor = New MyColor(160, 160, 160)
Delta = 4
ElseIf Inline.StartsWith("DARKGRAY") Then
TargetColor = New MyColor(90, 90, 90)
Delta = 8
Else
TargetColor = New MyColor(255, 255, 255)
Inline += "未知的颜色"
End If
Dim RealString As String = Inline.Substring(Delta)
'判断是否有禁用的字母
Dim HasDisabledLetter As Boolean = False
For Each Letter In RealString
If DisabledKey.Contains(Letter) Then
HasDisabledLetter = True
Exit For
End If
Next
If Not HasDisabledLetter Then
'无禁用字，直接添加
Target.Inlines.Add(New Run(StrConv(RealString, VbStrConv.Wide)) With {.Foreground = TargetColor})
Else
'有禁用字，逐个添加
Dim RightPart As String = ""
For Each Letter In RealString
If Letter = vbCr Then Continue For
If Letter = vbLf Then Letter = vbCrLf
If DisabledKey.Contains(Letter) Then
'清理 RightPart
If RightPart <> "" Then
Target.Inlines.Add(New Run(StrConv(RightPart, VbStrConv.Wide)) With {.Foreground = TargetColor})
RightPart = ""
End If
'修改字符与颜色
Dim RealTargetColor As MyColor
If Inline.StartsWith("YELLOW") Then
If RandomInteger(1, 10) > 5 Then Letter = Encoding.Default.GetString({RandomInteger(16 + 160, 87 + 160), RandomInteger(1 + 160, 89 + 160)})
RealTargetColor = TargetColor * RandomInteger(40, 70) * 0.01
Else
If RandomInteger(1, 10) > 9 Then Letter = Encoding.Default.GetString({RandomInteger(16 + 160, 87 + 160), RandomInteger(1 + 160, 89 + 160)})
RealTargetColor = TargetColor * ((RandomInteger(90, 100) * 0.01) ^ 2)
End If
Target.Inlines.Add(New Run(StrConv(Letter, VbStrConv.Wide)) With {.Foreground = RealTargetColor})
Else
RightPart += Letter
End If
Next
'清理 RightPart
If RightPart <> "" Then
Target.Inlines.Add(New Run(StrConv(RightPart, VbStrConv.Wide)) With {.Foreground = TargetColor})
RightPart = ""
End If
End If
Next
End Sub
'获取全角处理后的纯文本
Public Function GetRawText(Text As String) As String
Return StrConv(Text.Replace("\n", vbCrLf), VbStrConv.Wide)
End Function
'获取根据按键处理后的富文本
Public Function GetKeyText(Key As String) As String
Return "\YELLOW<" & Key & ">\WHITE"
End Function
'获取单个项目的富文本
Public Function GetItemText(Key As String, Title As String, Desc As String) As String
Return GetKeyText(Key) & " " & Title & vbCrLf & " " & Desc
End Function
'玩家输入指令
Public EnterStatus As EnterStatuses = EnterStatuses.Normal
Public Enum EnterStatuses
Normal
Chat
End Enum
Public Sub Enter(Input As String)
Select Case EnterStatus
Case EnterStatuses.Normal
SetText(FrmMain.TextInputResult, "\DARKGRAY等待玩家输入指令。")
If Input = "RST" Then
StartLevel(Level)
StartChat({"* 伊尔梅特的祝福已生效。\n 创伤已被抚平，时光已被重置。"}, False, False)
Exit Sub
ElseIf Input.StartsWith("TP ") Then
'存档
ItemCountLast = ItemCount.Clone
EquipWeaponLast = EquipWeapon
EquipArmorLast = EquipArmor
'传送
Level = Input.Replace("TP ", "")
StartLevel(Level)
Exit Sub
End If
Select Case Screen
Case Screens.Empty
Case Screens.Combat
Select Case Input
Case "ATK", "ATTACK"
ScreenReturn = Screen
Screen = Screens.Select
ScreenData = "ATK"
ScreenTitle = "攻击"
Exit Sub
Case "DEF", "DEFENCE"
ExtraDef += 100
StartChat({"* 你做好迎接敌人攻击的准备。\n 你在本回合内的防御略微提高了！", "/TURNEND"}, True, False)
Exit Sub
Case "MAG", "MAGIC"
Screen = Screens.Magic
Exit Sub
Case "EQU", "EQUIP", "EQUIPMENT"
Screen = Screens.Equip
Exit Sub
Case "ITM", "ITEM"
Screen = Screens.Item
Exit Sub
Case "WIN"
PerformLevelWin(Level)
Exit Sub
End Select
Case Screens.Select
'选取对象
Select Case Input
Case "A", "B", "C", "D", "E", "F", "G"
Dim Id As Integer = "ABCDEFG".IndexOf(Input)
If Id >= 0 AndAlso Id <= MonsterHp.Count - 1 Then
'选中对象：Id
PerformSelect(Id)
FrmMain.TextTitle.Opacity = 1 : AniStop("Title Opacity")
Exit Sub
End If
Case "ESC"
Screen = ScreenReturn
FrmMain.TextTitle.Opacity = 1 : AniStop("Title Opacity")
Exit Sub
End Select
Case Screens.Equip
'装备
Select Case Input
Case "1", "2", "3", "4", "5", "6", "7"
If EquipArmor = Input OrElse EquipWeapon = Input Then
SetText(FrmMain.TextInputResult, "\RED错误：你已装备该物品！")
PlaySound("Error.mp3", 0.35)
Else
If GetEquipIsWeapon(Input) Then
EquipWeapon = Input
Else
EquipArmor = Input
End If
StartChat({"* 你将你所装备的" & If(GetEquipIsWeapon(Input), "武器", "护甲") & "更换为了" & GetEquipTitle(Input) & "。" &
If(Input = 5, "\n 但你并不能在敌人的注视下尝试隐匿！", ""), "/TURNEND"}, True, False)
End If
Exit Sub
Case "ESC"
Screen = Screens.Combat
Exit Sub
End Select
Case Screens.Item
'道具
Select Case Input
Case "1", "2", "3", "4", "5", "6", "7"
If ItemCount(Input) = 0 Then
SetText(FrmMain.TextInputResult, "\RED错误：该道具槽位为空！")
PlaySound("Error.mp3", 0.35)
Else
UseItem(Input)
End If
Exit Sub
Case "ESC"
Screen = Screens.Combat
Exit Sub
End Select
Case Screens.Magic
'法术
Select Case Input
Case "1", "2", "3", "4", "5", "6", "7"
If Mp < GetMagicCost(Input) Then
SetText(FrmMain.TextInputResult, "\RED错误：你的魔力值不足！")
PlaySound("Error.mp3", 0.35)
Else
UseMagic(Input)
End If
Exit Sub
Case "ESC"
Screen = Screens.Combat
Exit Sub
End Select
End Select
SetText(FrmMain.TextInputResult, "\RED错误：指令未知或无效，请输入屏幕上以黄色显示的指令！")
PlaySound("Error.mp3", 0.35)
End Select
End Sub
'对话框
Private ChatContents As New List(Of String)
Private IsNowImportant As Boolean = False
Public Sub StartChat(Contents As String(), RequireEnsure As Boolean, IsImportant As Boolean)
ChatContents = New List(Of String)(Contents)
IsNowImportant = IsImportant
If RequireEnsure Then
EnterStatus = EnterStatuses.Chat
FrmMain.TextInputBox.Tag = ""
End If
FrmMain.TextChat.Text = ""
FrmMain.TextChat.Tag = ""
NextChat(False)
End Sub
Public AutoContinueChat As Boolean = False
Public ChatLevel As Integer = 0
Public Sub NextChat(IsHandSkip As Boolean)
If Not IsHandSkip Then AutoContinueChat = False
If FrmMain.TextChat.Text <> FrmMain.TextChat.Tag Then
'补全当前对话
If Not IsNowImportant Then
AniStop("Chat Content")
FrmMain.TextChat.Text = FrmMain.TextChat.Tag
End If
ElseIf ChatContents.Count > 0 AndAlso ChatContents(0).StartsWith("/") Then
'执行命令
AniStop("Chat Content")
Dim Cmd = ChatContents(0)
ChatContents.RemoveAt(0)
If ChatContents.Count = 0 Then EndChat()
If Cmd.StartsWith("/TURNEND") Then
TurnEnd()
ElseIf Cmd.StartsWith("/RESET") Then
Enter("RST")
ElseIf Cmd.StartsWith("/THEEND") Then
RunInNewThread(Sub()
Threading.Thread.Sleep(50)
RunInUi(Sub() StartChat({"* 制作：龙腾猫跃\n 音乐：来自《MONSTER HUNTER:WORLD》\n 音效：00ll00\n 感谢你的游玩！"}, False, False))
End Sub, "Win")
ElseIf Cmd.StartsWith("/WIN") Then
Enter("WIN")
ElseIf Cmd.StartsWith("/IMP") Then
IsNowImportant = Cmd.Replace("/IMP", "")
NextChat(False)
ElseIf Cmd.StartsWith("/LOCK") Then
DisabledKey &= Cmd.Replace("/LOCK", "")
NextChat(False)
ElseIf Cmd.StartsWith("/UNLOCK") Then
DisabledKey = DisabledKey.Replace(Cmd.Replace("/UNLOCK", ""), "")
NextChat(False)
ElseIf Cmd.StartsWith("/LEVEL") Then
Enter(Cmd.Replace("/LEVEL", "TP "))
End If
ElseIf IsNowImportant AndAlso IsHandSkip Then
'禁止手动继续自动剧情
Exit Sub
ElseIf ChatContents.Count > 0 Then
'下一句对话
If EnterStatus = EnterStatuses.Chat AndAlso IsNowImportant Then
ChatLevel = 2
SetText(FrmMain.TextInputResult, "\DARKGRAY剧情将自动播放。")
FrmMain.TextChat.Foreground = New MyColor(0, 255, 255)
ElseIf EnterStatus = EnterStatuses.Chat Then
ChatLevel = 1
SetText(FrmMain.TextInputResult, "\DARKGRAY请按任意键继续。")
FrmMain.TextChat.Foreground = New MyColor(255, 255, 255)
Else
ChatLevel = 0
FrmMain.TextChat.Foreground = New MyColor(100, 100, 100)
End If
'处理文本
Dim RawText As String = GetRawText(ChatContents.First)
FrmMain.TextChat.Text = RawText
FrmMain.TextChat.Tag = FrmMain.TextChat.Text
'播放动画
AniStart({
AaTextAppear(FrmMain.TextChat, Time:=If(IsNowImportant, 55, 35)),
AaCode(Sub() If IsNowImportant Then AutoContinueChat = True, 1200 + RawText.Length * 20, True)
}, "Chat Content")
FrmMain.TextChat.Text = "" '防止动画结束前闪现
ChatContents.RemoveAt(0)
Else
'结束对话
AniStop("Chat Content")
EndChat()
End If
End Sub
Public Sub EndChat()
If EnterStatus = EnterStatuses.Chat Then
EnterStatus = EnterStatuses.Normal
SetText(FrmMain.TextInputResult, "\DARKGRAY等待玩家输入指令。")
End If
FrmMain.TextChat.Text = ""
FrmMain.TextChat.Tag = ""
End Sub
End Module