Files
staxrip/Forms/CodeEditor.vb
T

707 lines
28 KiB
VB.net

Imports System.Text.RegularExpressions
Imports Microsoft.Win32
Imports StaxRip.UI
Public Class CodeEditor
Property ActiveTable As FilterTable
Property Engine As ScriptEngine
Sub New(doc As VideoScript)
InitializeComponent()
KeyPreview = True
MainFlowLayoutPanel.Padding = New Padding(0, 0, 0, 0)
MainFlowLayoutPanel.SuspendLayout()
Engine = doc.Engine
For Each i In doc.Filters
MainFlowLayoutPanel.Controls.Add(CreateFilterTable(i))
Next
MainFlowLayoutPanel.ResumeLayout()
AddHandler MainFlowLayoutPanel.Layout, AddressOf MainFlowLayoutPanelLayout
AutoSizeMode = AutoSizeMode.GrowAndShrink
AutoSize = True
End Sub
Protected Overrides Sub OnKeyDown(e As KeyEventArgs)
Select Case e.KeyData
Case Keys.F5
VideoPreview()
Case Keys.F9
PlayScriptWithMPV()
Case Keys.F10
PlayScriptWithMPC()
Case Keys.Control Or Keys.Delete
If Not ActiveTable Is Nothing Then
ActiveTable.RemoveClick()
End If
Case Keys.Control Or Keys.Up
If Not ActiveTable Is Nothing Then
ActiveTable.MoveUp()
End If
Case Keys.Control Or Keys.Down
If Not ActiveTable Is Nothing Then
ActiveTable.MoveDown()
End If
Case Keys.Control Or Keys.I
ShowInfo()
Case Keys.Control Or Keys.J
JoinFilters()
Case Keys.Control Or Keys.P
g.MainForm.ShowFilterProfilesDialog()
Case Keys.Control Or Keys.M
MacrosForm.ShowDialogForm()
End Select
MyBase.OnKeyDown(e)
End Sub
Shared Function CreateFilterTable(filter As VideoFilter) As FilterTable
Dim ret As New FilterTable
ret.Margin = New Padding(0)
ret.Size = New Size(950, 50)
ret.cbActive.Checked = filter.Active
ret.cbActive.Text = filter.Category
ret.tbName.Text = filter.Name
ret.rtbScript.Text = If(filter.Script = "", "", filter.Script + BR)
ret.SetColor()
Return ret
End Function
Function GetFilters() As List(Of VideoFilter)
Dim ret As New List(Of VideoFilter)
For Each table As FilterTable In MainFlowLayoutPanel.Controls
Dim filter As New VideoFilter()
filter.Active = table.cbActive.Checked
filter.Category = table.cbActive.Text
filter.Path = table.tbName.Text
filter.Script = table.rtbScript.Text.FixBreak.Trim
ret.Add(filter)
Next
Return ret
End Function
Function CreateTempScript() As VideoScript
Dim script As New VideoScript
script.Engine = Engine
script.Path = (p.TempDir + p.TargetFile.Base + $"_temp." + script.FileType).ToShortFilePath
script.Filters = GetFilters()
If script.GetError <> "" Then
MsgError("Script Error", script.GetError)
Exit Function
End If
Return script
End Function
Sub PlayScriptWithMPV()
g.PlayScriptWithMPV(CreateTempScript())
End Sub
Sub PlayScriptWithMPC()
g.PlayScriptWithMPC(CreateTempScript())
End Sub
Sub VideoPreview()
If p.SourceFile = "" Then
Exit Sub
End If
Dim script = CreateTempScript()
If script Is Nothing Then
Exit Sub
End If
script.RemoveFilter("Cutting")
Dim form As New PreviewForm(script)
form.Owner = g.MainForm
form.Show()
End Sub
Sub ShowInfo()
Dim script = CreateTempScript()
If Not script Is Nothing Then
g.ShowScriptInfo(script)
End If
End Sub
Sub ShowAdvancedInfo()
Dim script = CreateTempScript()
If script Is Nothing Then
Exit Sub
End If
g.ShowAdvancedScriptInfo(script)
End Sub
Sub JoinFilters()
Dim firstTable = DirectCast(MainFlowLayoutPanel.Controls(0), FilterTable)
firstTable.tbName.Text = "merged"
firstTable.rtbScript.Text = MainFlowLayoutPanel.Controls.OfType(Of FilterTable).Select(Function(arg) If(arg.cbActive.Checked, arg.rtbScript.Text.Trim, "#" + arg.rtbScript.Text.Trim.FixBreak.Replace(BR, "# " + BR))).Join(BR) + BR2 + BR2
For x = MainFlowLayoutPanel.Controls.Count - 1 To 1 Step -1
MainFlowLayoutPanel.Controls.RemoveAt(x)
Next
End Sub
Sub MainFlowLayoutPanelLayout(sender As Object, e As LayoutEventArgs)
Dim filterTables = MainFlowLayoutPanel.Controls.OfType(Of FilterTable)
If filterTables.Count = 0 Then
Exit Sub
End If
Dim maxTextWidth = Aggregate i In filterTables Into Max(i.TrimmedTextSize.Width)
For Each table As FilterTable In MainFlowLayoutPanel.Controls
Dim sizeRTB As Size
sizeRTB.Width = maxTextWidth + FontHeight
sizeRTB.Height = table.TrimmedTextSize.Height + CInt(FontHeight * 0.3)
table.rtbScript.Size = sizeRTB
table.rtbScript.Refresh()
Next
End Sub
Sub CodeEditor_HelpRequested(sender As Object, hlpevent As HelpEventArgs) Handles Me.HelpRequested
Dim form As New HelpForm()
form.Doc.WriteStart(Text)
form.Doc.WriteTable("Macros", Macro.GetTips(False, True, False))
form.Show()
End Sub
Public Class FilterTable
Inherits TableLayoutPanel
Property tbName As New TextEdit
Property rtbScript As RichTextBoxEx
Property cbActive As New CheckBox
Property Menu As New ContextMenuStripEx
Property LastTextSize As Size
Property Editor As CodeEditor
Sub New()
AutoSize = True
cbActive.AutoSize = True
cbActive.Anchor = AnchorStyles.Left Or AnchorStyles.Right
cbActive.Margin = New Padding(0)
tbName.Dock = DockStyle.Top
tbName.Margin = New Padding(0, 0, 0, 0)
rtbScript = New RichTextBoxEx(False)
rtbScript.EnableAutoDragDrop = True
rtbScript.Dock = DockStyle.Fill
rtbScript.WordWrap = False
rtbScript.ScrollBars = RichTextBoxScrollBars.None
rtbScript.AcceptsTab = True
rtbScript.Margin = New Padding(0)
rtbScript.Font = New Font("Consolas", 10 * s.UIScaleFactor)
AddHandler Disposed, Sub() Menu.Dispose()
AddHandler cbActive.CheckedChanged, Sub() SetColor()
AddHandler rtbScript.MouseUp, AddressOf HandleMouseUp
AddHandler rtbScript.Enter, Sub() Editor.ActiveTable = Me
AddHandler rtbScript.TextChanged, Sub()
If Parent Is Nothing Then Exit Sub
Dim filterTables = Parent.Controls.OfType(Of FilterTable)
Dim maxTextWidth = Aggregate i In filterTables Into Max(i.TrimmedTextSize.Width)
Dim textSizeVar = TrimmedTextSize
If textSizeVar.Width > maxTextWidth OrElse
(textSizeVar.Width = maxTextWidth AndAlso
textSizeVar.Width <> LastTextSize.Width) OrElse
LastTextSize.Height <> textSizeVar.Height AndAlso
textSizeVar.Height > FontHeight Then
Parent.PerformLayout()
LastTextSize = TrimmedTextSize
End If
End Sub
ColumnCount = 2
ColumnStyles.Add(New ColumnStyle(SizeType.AutoSize))
ColumnStyles.Add(New ColumnStyle(SizeType.AutoSize))
RowCount = 1
RowStyles.Add(New RowStyle(SizeType.AutoSize))
Dim t As New TableLayoutPanel
t.AutoSize = True
t.SuspendLayout()
t.Dock = DockStyle.Fill
t.Margin = New Padding(0)
t.ColumnCount = 1
t.ColumnStyles.Add(New ColumnStyle(SizeType.AutoSize))
t.RowCount = 2
t.RowStyles.Add(New RowStyle(SizeType.AutoSize))
t.RowStyles.Add(New RowStyle(SizeType.AutoSize))
t.Controls.Add(cbActive, 0, 0)
t.Controls.Add(tbName, 0, 1)
t.ResumeLayout()
Controls.Add(t, 0, 0)
Controls.Add(rtbScript, 1, 0)
End Sub
Protected Overrides Sub OnLayout(levent As LayoutEventArgs)
tbName.Height = CInt(FontHeight * 1.2)
tbName.Width = FontHeight * 7
MyBase.OnLayout(levent)
End Sub
Protected Overrides Sub OnHandleCreated(e As EventArgs)
Menu.Form = FindForm()
Editor = DirectCast(Menu.Form, CodeEditor)
MyBase.OnHandleCreated(e)
End Sub
Sub SetColor()
If cbActive.Checked Then
rtbScript.ForeColor = Color.Black
tbName.TextBox.ForeColor = Color.Black
cbActive.ForeColor = Color.Black
Else
rtbScript.ForeColor = Color.Gray
tbName.TextBox.ForeColor = Color.Gray
cbActive.ForeColor = Color.Gray
End If
End Sub
ReadOnly Property TextSize As Size
Get
Return TextRenderer.MeasureText(rtbScript.Text, rtbScript.Font, New Size(100000, 100000))
End Get
End Property
ReadOnly Property MaxTextWidth As Integer
Get
Return Font.Height * 40
End Get
End Property
ReadOnly Property MaxTextHeight As Integer
Get
Return Font.Height * 15
End Get
End Property
ReadOnly Property TrimmedTextSize As Size
Get
Dim ret = TextSize
If ret.Width > MaxTextWidth Then
ret.Width = MaxTextWidth
End If
If ret.Height > MaxTextHeight Then
ret.Height = MaxTextHeight
End If
Return ret
End Get
End Property
Sub SetParameters(parameters As FilterParameters)
Dim code = rtbScript.Text.FixBreak
Dim match = Regex.Match(code, parameters.FunctionName + "\((.+)\)")
Dim args = FilterParameters.SplitCSV(match.Groups(1).Value)
Dim newParameters As New List(Of String)
For Each argument In args
Dim skip = False
For Each parameter In parameters.Parameters
If argument.ToLower.RemoveChars(" ").Contains(
parameter.Name.ToLower.RemoveChars(" ") + "=") Then
skip = True
End If
Next
If Not skip Then
newParameters.Add(argument)
End If
Next
For Each parameter In parameters.Parameters
Dim value = parameter.Value
If Editor.Engine = ScriptEngine.VapourSynth Then
value = value.Replace("""", "'")
End If
newParameters.Add(parameter.Name + "=" + value)
Next
rtbScript.Text = Regex.Replace(code, parameters.FunctionName + "\((.+)\)",
parameters.FunctionName + "(" + newParameters.Join(", ") + ")")
End Sub
Sub HandleMouseUp(sender As Object, e As MouseEventArgs)
If e.Button <> MouseButtons.Right Then
Exit Sub
End If
Menu.Items.ClearAndDisplose
Dim filterProfiles = If(p.Script.Engine = ScriptEngine.AviSynth, s.AviSynthProfiles, s.VapourSynthProfiles)
Dim code = rtbScript.Text.FixBreak
For Each i In FilterParameters.Definitions
If code.Contains(i.FunctionName + "(") Then
Dim match = Regex.Match(code, i.FunctionName + "\((.+)\)")
If match.Success Then
ActionMenuItem.Add(Menu.Items, i.Text, AddressOf SetParameters, i)
End If
End If
Next
For Each i In filterProfiles
If i.Name = cbActive.Text Then
Dim cat = i
Dim catMenuItem = Menu.Add(i.Name)
For Each iFilter In cat.Filters
Dim tip = iFilter.Script
ActionMenuItem.Add(Menu.Items, If(cat.Filters.Count > 1, iFilter.Category + " | ", "") + iFilter.Path, AddressOf ReplaceClick, iFilter.GetCopy, tip)
Next
End If
Next
Dim filterMenuItem = Menu.Add("Add, insert or replace a filter ")
filterMenuItem.SetImage(Symbol.Filter)
ActionMenuItem.Add(filterMenuItem.DropDownItems, "Empty Filter", AddressOf FilterClick, New VideoFilter("Misc", "", ""), "Filter with empty values.")
For Each filterCategory In filterProfiles
For Each filter In filterCategory.Filters
Dim tip = filter.Script
ActionMenuItem.Add(filterMenuItem.DropDownItems, filterCategory.Name + " | " + filter.Path, AddressOf FilterClick, filter.GetCopy, tip)
Next
Next
Dim removeMenuItem = Menu.Add("Remove", AddressOf RemoveClick)
removeMenuItem.KeyDisplayString = "Ctrl+Delete"
removeMenuItem.SetImage(Symbol.Remove)
Dim previewMenuItem = Menu.Add("Preview Video...", AddressOf Editor.VideoPreview, "Previews the script with solved macros.")
previewMenuItem.Enabled = p.SourceFile <> ""
previewMenuItem.KeyDisplayString = "F5"
previewMenuItem.SetImage(Symbol.Photo)
Dim mpvnetMenuItem = Menu.Add("Play with mpv.net", AddressOf Editor.PlayScriptWithMPV, "Plays the current script with mpv.net.")
mpvnetMenuItem.Enabled = p.SourceFile <> ""
mpvnetMenuItem.KeyDisplayString = "F9"
mpvnetMenuItem.SetImage(Symbol.Play)
Dim mpcMenuItem = Menu.Add("Play with mpc", AddressOf Editor.PlayScriptWithMPC, "Plays the current script with MPC.")
mpcMenuItem.Enabled = p.SourceFile <> ""
mpcMenuItem.KeyDisplayString = "F10"
mpcMenuItem.SetImage(Symbol.Play)
Menu.Add("Preview Code...", AddressOf CodePreview, "Previews the script with solved macros.").SetImage(Symbol.Code)
Dim infoMenuItem = Menu.Add("Info...", AddressOf Editor.ShowInfo, "Previews script parameters such as framecount and colorspace.")
infoMenuItem.SetImage(Symbol.Info)
infoMenuItem.KeyDisplayString = "Ctrl+I"
infoMenuItem.Enabled = p.SourceFile <> ""
Menu.Add("Advanced Info...", AddressOf Editor.ShowAdvancedInfo, p.SourceFile <> "").SetImage(Symbol.Lightbulb)
Dim joinMenuItem = Menu.Add("Join Filters", AddressOf Editor.JoinFilters, "Joins all filters into one filter.")
joinMenuItem.Enabled = DirectCast(Parent, FlowLayoutPanel).Controls.Count > 1
joinMenuItem.ShortcutKeyDisplayString = "Ctrl+J "
Dim profilesMenuItem = Menu.Add("Profiles...", AddressOf g.MainForm.ShowFilterProfilesDialog, "Dialog to edit profiles.")
profilesMenuItem.KeyDisplayString = "Ctrl+P"
profilesMenuItem.SetImage(Symbol.FavoriteStar)
Dim macrosMenuItem = Menu.Add("Macros...", AddressOf MacrosForm.ShowDialogForm, "Dialog to choose macros.")
macrosMenuItem.KeyDisplayString = "Ctrl+M"
macrosMenuItem.SetImage(Symbol.CalculatorPercentage)
Menu.Add("-")
Dim moveUpMenuItem = Menu.Add("Move Up", AddressOf MoveUp)
moveUpMenuItem.KeyDisplayString = "Ctrl+Up"
moveUpMenuItem.SetImage(Symbol.Up)
Dim moveDownMenuItem = Menu.Add("Move Down", AddressOf MoveDown)
moveDownMenuItem.KeyDisplayString = "Ctrl+Down"
moveDownMenuItem.SetImage(Symbol.Down)
Menu.Add("-")
Dim cutAction = Sub()
Clipboard.SetText(rtbScript.SelectedText)
rtbScript.SelectedText = ""
End Sub
Dim copyAction = Sub() Clipboard.SetText(rtbScript.SelectedText)
Dim pasteAction = Sub()
rtbScript.SelectedText = Clipboard.GetText
rtbScript.ScrollToCaret()
End Sub
Dim cutMenuItem = Menu.Add("Cut", cutAction, rtbScript.SelectionLength > 0 AndAlso Not rtbScript.ReadOnly)
cutMenuItem.SetImage(Symbol.Cut)
cutMenuItem.KeyDisplayString = "Ctrl+X"
Dim copyMenuItem = Menu.Add("Copy", copyAction, rtbScript.SelectionLength > 0)
copyMenuItem.SetImage(Symbol.Copy)
copyMenuItem.KeyDisplayString = "Ctrl+C"
Dim pasteMenuItem = Menu.Add("Paste", pasteAction, Clipboard.GetText <> "" AndAlso Not rtbScript.ReadOnly)
pasteMenuItem.SetImage(Symbol.Paste)
pasteMenuItem.KeyDisplayString = "Ctrl+V"
Menu.Add("-")
Dim helpMenuItem = Menu.Add("Help")
helpMenuItem.SetImage(Symbol.Help)
Dim helpTempMenuItem = Menu.Add("Help | temp")
Dim helpAction = Sub()
For Each pluginPack In Package.Items.Values.OfType(Of PluginPackage)()
If Not pluginPack.AvsFilterNames Is Nothing Then
For Each avsFilterName In pluginPack.AvsFilterNames
If rtbScript.Text.Contains(avsFilterName) Then
Dim helpPath = pluginPack.HelpFileOrURL
If helpPath <> "" Then
Menu.Add("Help | " + pluginPack.Name, Sub() pluginPack.ShowHelp(), pluginPack.Description)
End If
End If
Next
End If
Next
If p.Script.Engine = ScriptEngine.AviSynth Then
Dim installDir = Registry.LocalMachine.GetString("SOFTWARE\AviSynth", Nothing)
Dim helpText = rtbScript.Text.Left("(")
If helpText.EndsWith("Resize") Then helpText = "Resize"
If helpText.StartsWith("ConvertTo") Then helpText = "Convert"
Dim filterPath = installDir + "\Docs\English\corefilters\" + helpText + ".htm"
If File.Exists(filterPath) Then
Menu.Add("Help | " + helpText, Sub() g.ShellExecute(filterPath), filterPath)
End If
Dim helpIndex = installDir + "\Docs\English\overview.htm"
If File.Exists(helpIndex) Then
Menu.Add("Help | AviSynth local", Sub() g.ShellExecute(helpIndex), helpIndex)
End If
Menu.Add("Help | AviSynth Help", Sub() g.ShellExecute("http://avisynth.nl"), "http://avisynth.nl")
Menu.Add("Help | -")
For Each pluginPack In Package.Items.Values.OfType(Of PluginPackage)
Dim helpPath = pluginPack.HelpFileOrURL
If helpPath <> "" AndAlso Not pluginPack.AvsFilterNames Is Nothing Then
Menu.Add("Help | " + pluginPack.Name.Substring(0, 1).ToUpper + " | " + pluginPack.Name, Sub() pluginPack.ShowHelp(), pluginPack.Description)
Application.DoEvents()
End If
Next
Else
Menu.Add("Help | VapourSynth Help", Sub() Package.VapourSynth.ShowHelp(), Package.VapourSynth.HelpFileOrURL)
Menu.Add("Help | -")
For Each pluginPack In Package.Items.Values.OfType(Of PluginPackage)
Dim helpPath = pluginPack.HelpFileOrURL
If helpPath <> "" AndAlso Not pluginPack.VSFilterNames Is Nothing Then
Menu.Add("Help | " + pluginPack.Name.Substring(0, 1).ToUpper + " | " + pluginPack.Name, Sub() pluginPack.ShowHelp(), pluginPack.Description)
Application.DoEvents()
End If
Next
End If
End Sub
AddHandler helpMenuItem.DropDownOpened, Sub()
If helpMenuItem.DropDownItems.Count > 1 Then
Exit Sub
End If
helpTempMenuItem.Visible = False
helpAction()
End Sub
Menu.Show(rtbScript, e.Location)
End Sub
Sub MoveUp()
Dim flow = DirectCast(Parent, FlowLayoutPanel)
Dim index = flow.Controls.IndexOf(Me)
index -= 1
If index < 0 Then
index = 0
End If
flow.Controls.SetChildIndex(Me, index)
End Sub
Sub MoveDown()
Dim flow = DirectCast(Parent, FlowLayoutPanel)
Dim index = flow.Controls.IndexOf(Me)
index += 1
If index >= flow.Controls.Count - 1 Then
index = flow.Controls.Count - 1
End If
flow.Controls.SetChildIndex(Me, index)
End Sub
Sub CodePreview()
Dim script As New VideoScript
script.Engine = Editor.Engine
script.Filters = Editor.GetFilters()
g.CodePreview(script.GetFullScript)
End Sub
Sub RemoveClick()
If MsgQuestion("Remove?") = DialogResult.OK Then
Dim flow = DirectCast(Parent, FlowLayoutPanel)
If flow.Controls.Count > 1 Then
flow.Controls.Remove(Me)
Dispose()
Editor.ActiveTable = Nothing
End If
End If
End Sub
Sub FilterClick(filter As VideoFilter)
Using td As New TaskDialog(Of String)
td.MainInstruction = "Choose action"
td.AddCommand("Replace selection", "Replace")
td.AddCommand("Insert at selection", "Insert")
td.AddCommand("Add to end", "Add")
Select Case td.Show
Case "Replace"
Dim tup = Macro.ExpandGUI(filter.Script)
If tup.Cancel Then
Exit Sub
End If
cbActive.Checked = filter.Active
cbActive.Text = filter.Category
If tup.Value <> filter.Script AndAlso tup.Caption <> "" Then
If filter.Script.StartsWith("$") Then
tbName.Text = tup.Caption
Else
tbName.Text = filter.Name.Replace("...", "") + " " + tup.Caption
End If
Else
tbName.Text = filter.Name
End If
rtbScript.Text = tup.Value.TrimEnd + BR
rtbScript.SelectionStart = rtbScript.Text.Length
Application.DoEvents()
Menu.Items.ClearAndDisplose
Case "Insert"
Dim tup = Macro.ExpandGUI(filter.Script)
If tup.Cancel Then
Exit Sub
End If
If tup.Value <> filter.Script AndAlso tup.Caption <> "" Then
If filter.Script.StartsWith("$") Then
filter.Path = tup.Caption
Else
filter.Path = filter.Path.Replace("...", "") + " " + tup.Caption
End If
End If
filter.Script = tup.Value
Dim flow = DirectCast(Parent, FlowLayoutPanel)
Dim index = flow.Controls.IndexOf(Me)
Dim filterTable = CodeEditor.CreateFilterTable(filter)
flow.SuspendLayout()
flow.Controls.Add(filterTable)
flow.Controls.SetChildIndex(filterTable, index)
flow.ResumeLayout()
filterTable.rtbScript.SelectionStart = filterTable.rtbScript.Text.Length
filterTable.rtbScript.Focus()
Application.DoEvents()
Menu.Items.ClearAndDisplose
Case "Add"
Dim tup = Macro.ExpandGUI(filter.Script)
If tup.Cancel Then
Exit Sub
End If
If tup.Value <> filter.Script AndAlso tup.Caption <> "" Then
If filter.Script.StartsWith("$") Then
filter.Path = tup.Caption
Else
filter.Path = filter.Path.Replace("...", "") + " " + tup.Caption
End If
End If
filter.Script = tup.Value
Dim flow = DirectCast(Parent, FlowLayoutPanel)
Dim filterTable = CodeEditor.CreateFilterTable(filter)
flow.Controls.Add(filterTable)
filterTable.rtbScript.SelectionStart = filterTable.rtbScript.Text.Length
filterTable.rtbScript.Focus()
Application.DoEvents()
Menu.Items.ClearAndDisplose
End Select
End Using
End Sub
Sub ReplaceClick(filter As VideoFilter)
Dim tup = Macro.ExpandGUI(filter.Script)
If tup.Cancel Then
Exit Sub
End If
cbActive.Checked = filter.Active
cbActive.Text = filter.Category
If tup.Value <> filter.Script AndAlso tup.Caption <> "" Then
If filter.Script.StartsWith("$") Then
tbName.Text = tup.Caption
Else
tbName.Text = filter.Name.Replace("...", "") + " " + tup.Caption
End If
Else
tbName.Text = filter.Name
End If
rtbScript.Text = tup.Value.TrimEnd + BR
rtbScript.SelectionStart = rtbScript.Text.Length
Application.DoEvents()
Menu.Items.ClearAndDisplose
End Sub
End Class
End Class