merge from mc

instat/My Project/AssemblyInfo.vb

@@ -17,6 +17,8 @@ Imports System.Runtime.InteropServices
 <Assembly: AssemblyTrademark("")>
 
 <Assembly: ComVisible(False)>
+'Temporary fix for auto rescale on high resolution screens: enable rescale...
+<Assembly: System.Windows.Media.DisableDpiAwareness>
 
 'The following GUID is for the ID of the typelib if this project is exposed to COM
 <Assembly: Guid("439a7cc0-b11e-4e59-879d-98531a6750f3")>

instat/clsRLink.vb

@@ -23,8 +23,8 @@ Public Class RLink
     Dim strInstatObjectPath As String = "/InstatObject/R" 'path to the Instat object
     Public strInstatDataObject As String = "InstatDataObject"
     Public clsEngine As REngine
-    Dim txtOutput As New RichTextBox
-    Dim txtLog As New TextBox
+    Public rtbOutput As New ucrWPFRichTextBox
+    Public txtLog As New TextBox
     Public bLog As Boolean = False
     Public bOutput As Boolean = False
     Public bClimateObjectExists As Boolean = False
@@ -73,13 +73,14 @@ Public Class RLink
     Public Sub setFormatComment(tempFont As Font, tempColor As Color)
         fComments = tempFont
         clrComments = tempColor
-    End Sub
-
-    Public Sub SetOutput(tempOutput As RichTextBox)
-        txtOutput = tempOutput
-        bOutput = True
     End Sub
 
+    Public Sub SetOutput(tempOutput As ucrWPFRichTextBox)
+        'TEST temporary
+        rtbOutput = tempOutput
+        bOutput = True
+    End Sub
+
     Public Sub SetLog(tempLog As TextBox)
         txtLog = tempLog
         bLog = True
@@ -216,95 +217,101 @@ Public Class RLink
         Return strNextDefault
     End Function
 
-    Public Sub RunScript(strScript As String, Optional bReturnOutput As Integer = 0, Optional strComment As String = "")
+    Public Sub RunScript(strScript As String, Optional iCallType As Integer = 0, Optional strComment As String = "", Optional bHtmlOutput As Boolean = False)
         Dim strCapturedScript As String
         Dim temp As RDotNet.SymbolicExpression
         Dim strTemp As String
         Dim strOutput As String
         Dim strScriptWithComment As String
         Dim strSplitScript As String
+        Dim strTempGraphsDirectory As String
+        Dim clsPNGFunction As New RFunction
+
+        strTempGraphsDirectory = IO.Path.Combine(IO.Path.GetTempPath() & "R_Instat_Temp_Graphs")
         strOutput = ""
 
         If strComment <> "" Then
             strComment = "# " & strComment
-            strScriptWithComment = strComment & vbCrLf & strScript
+            strScriptWithComment = strComment & Environment.NewLine & strScript
         Else
             strScriptWithComment = strScript
         End If
         If bLog Then
-            txtLog.Text = txtLog.Text & strScriptWithComment & vbCrLf
+            txtLog.Text = txtLog.Text & strScriptWithComment & Environment.NewLine
         End If
         If bOutput Then
             If strComment <> "" Then
-                AppendText(txtOutput, clrComments, fComments, strComment & vbCrLf)
+                rtbOutput.AppendText(clrComments, fComments, strComment & Environment.NewLine, clrScript, fScript, strScript & Environment.NewLine) 'TEST temporary
+            Else
+                rtbOutput.AppendText(clrScript, fScript, strScript & Environment.NewLine) 'TEST temporary
             End If
-            AppendText(txtOutput, clrScript, fScript, strScript & vbCrLf)
         End If
 
         'If strScript.Length > 2000 Then
         '    MsgBox("The following command cannot be run because it exceeds the character limit of 2000 characters for a command in R-Instat." & vbNewLine & strScript & vbNewLine & vbNewLine & "It may be possible to run the command directly in R.", MsgBoxStyle.Critical, "Cannot run command")
-        If bReturnOutput = 0 Then
+        If iCallType = 0 OrElse iCallType = 3 Then
             Try
+                If iCallType = 3 Then
+                    clsPNGFunction.SetRCommand("png")
+                    clsPNGFunction.AddParameter("filename", Chr(34) & IO.Path.Combine(strTempGraphsDirectory & "/Graph.png").Replace("\", "/") & Chr(34))
+                    clsPNGFunction.AddParameter("width", 4000)
+                    clsPNGFunction.AddParameter("height", 4000)
+                    clsPNGFunction.AddParameter("res", 500)
+                    clsEngine.Evaluate(clsPNGFunction.ToScript())
+                    'need to boost resolution of the devices, it's not as good as with ggsave.
+                End If
                 clsEngine.Evaluate(strScript)
+                If iCallType = 3 Then
+                    'add an R script (maybe in the form of one of our methods) that copies divices to the temp directory, using the default device production... use dev.list() and dev.copy() with arguments device = the devices in the list and which = jpeg devices with different paths leading to the temp directory, using a paste() method to find different names for the files
+                    clsEngine.Evaluate("graphics.off()") 'not quite sure if this would work, otherwise find the right way to close the appropriate devices.
+                    'clsEngine.Evaluate("ggsave(" & Chr(34) & strTempGraphsDirectory.Replace("\", "/") & "Graph.jpg" & Chr(34) & ")")
+                    'This sub is used to display graphics in the output window when necessary.
+                    rtbOutput.TestForGraphics()
+                End If
             Catch e As Exception
                 MsgBox(e.Message & vbNewLine & "The error occurred in attempting to run the following R command(s):" & vbNewLine & strScript, MsgBoxStyle.Critical, "Error running R command(s)")
             End Try
-        ElseIf bReturnOutput = 1 Then
+
+        ElseIf iCallType = 1 Then
             Try
                 temp = clsEngine.Evaluate(strScript)
-                strTemp = String.Join(vbCrLf, temp.AsCharacter())
-                strOutput = strOutput & strTemp & vbCrLf
+                strTemp = String.Join(Environment.NewLine, temp.AsCharacter())
+                strOutput = strOutput & strTemp & Environment.NewLine
             Catch e As Exception
                 MsgBox(e.Message & vbNewLine & "The error occurred in attempting to run the following R command(s):" & vbNewLine & strScript, MsgBoxStyle.Critical, "Error running R command(s)")
             End Try
         Else
-            If strScript.Trim(vbCrLf).LastIndexOf(vbCrLf) = -1 Then
+            If strScript.Trim(Environment.NewLine).LastIndexOf(Environment.NewLine) = -1 Then
                 strCapturedScript = "capture.output(" & strScript & ")"
             Else
-                strSplitScript = Left(strScript, strScript.Trim(vbCrLf).LastIndexOf(vbCrLf))
+                strSplitScript = Left(strScript, strScript.Trim(Environment.NewLine).LastIndexOf(Environment.NewLine))
                 If strSplitScript <> "" Then
                     Try
                         clsEngine.Evaluate(strSplitScript)
                     Catch e As Exception
                         MsgBox(e.Message & vbNewLine & "The error occurred in attempting to run the following R command(s):" & vbNewLine & strScript, MsgBoxStyle.Critical, "Error running R command(s)")
                     End Try
                 End If
-                strSplitScript = Right(strScript, strScript.Length - strScript.Trim(vbCrLf).LastIndexOf(vbCrLf) - 2)
+                strSplitScript = Right(strScript, strScript.Length - strScript.Trim(Environment.NewLine).LastIndexOf(Environment.NewLine) - 2)
                 strCapturedScript = "capture.output(" & strSplitScript & ")"
             End If
             Try
                 temp = clsEngine.Evaluate(strCapturedScript)
-                strTemp = String.Join(vbCrLf, temp.AsCharacter())
-                strOutput = strOutput & strTemp & vbCrLf
+                strTemp = String.Join(Environment.NewLine, temp.AsCharacter())
+                strOutput = strOutput & strTemp & Environment.NewLine
             Catch e As Exception
                 MsgBox(e.Message & vbNewLine & "The error occurred in attempting to run the following R command(s):" & vbNewLine & strScript, MsgBoxStyle.Critical, "Error running R command(s)")
             End Try
         End If
-        If bOutput Then
-            AppendText(txtOutput, clrOutput, fOutput, strOutput)
+        If bOutput AndAlso strOutput <> "" Then
+            If bHtmlOutput Then 'TEST temporary
+                rtbOutput.AddIntoWebBrowser(strHtmlCode:=strOutput) 'TEST temporary
+            Else
+                rtbOutput.AppendText(clrOutput, fOutput, strOutput) 'TEST temporary
+            End If
         End If
         frmMain.clsGrids.UpdateGrids()
     End Sub
-
-    Private Sub AppendText(box As RichTextBox, color As Color, font As Font, text As String)
-        Dim iStart As Integer
-        Dim iEnd As Integer
-
-        iStart = box.TextLength
-        box.AppendText(text)
-        iEnd = box.TextLength
-
-
-        ' Textbox may transform chars, so (end-start) != text.Length
-        box.[Select](iStart, iEnd - iStart)
-        box.SelectionColor = color
-        box.SelectionFont = font
-        'TClears selection
-        box.SelectionLength = 0
-        ' clear
-        box.SelectionStart = box.Text.Length
-        box.ScrollToCaret()
-    End Sub
 
     Public Function RunInternalScriptGetValue(strScript As String, Optional strVariableName As String = ".temp_value", Optional bSilent As Boolean = False) As SymbolicExpression
         Dim expTemp As SymbolicExpression
@@ -386,8 +393,9 @@ Public Class RLink
         Else
             Return False
         End If
-    End Function
-
+    End Function
+
+
     Public Function GetDefaultDataFrameName(strPrefix As String, Optional iStartIndex As Integer = 1, Optional bIncludeIndex As Boolean = True) As String
         Dim strTemp As String
         Dim clsGetNextDataName As New RFunction

instat/dlgGeneralForGraphics.vb

@@ -54,7 +54,8 @@ Public Class dlgGeneralForGraphics
         ucrBase.clsRsyntax.bExcludeAssignedFunctionOutput = False
         'By default, we want to put in the script the output of our Base R-command (in this case the ...+...+...) even when it has been assigned to some object (in which case we want the name of that object in the script so that it's called when the script is run).
         'For example, when a graph is saved, it is assigned to it's place in an R-instat object. If we had set bExcludeAssignedFunctionOutput to True, then we would never print the graph when running the script.
-
+        ucrBase.clsRsyntax.iCallType = 3
+        'iCalltype 3 corresponds to single graphics display in output window.
     End Sub
 
     Private Sub SetDefaults()
@@ -164,6 +165,7 @@ Public Class dlgGeneralForGraphics
     'End Sub
 
     Private Sub ucrSaveGraph_GraphNameChanged() Handles ucrSaveGraph.GraphNameChanged, ucrSaveGraph.SaveGraphCheckedChanged
+        'Warning/Task: this method seems weird to me, why do we get the dataframe from sdgLayerOptions ???!
         If ucrSaveGraph.bSaveGraph Then
             ucrBase.clsRsyntax.SetAssignTo(ucrSaveGraph.strGraphName, strTempDataframe:=sdgLayerOptions.ucrGeomWithAes.ucrGeomWithAesSelector.ucrAvailableDataFrames.cboAvailableDataFrames.Text, strTempGraph:=ucrSaveGraph.strGraphName)
         Else
@@ -186,4 +188,22 @@ Public Class dlgGeneralForGraphics
         'When the number of Layers in the lstLayers on ucrAdditionalLayers need to check if OK is enabled on dlgGeneralForGraphics.
         TestOKEnabled()
     End Sub
+
+    'Private Sub DisplayGraphInOutputWindow_When_ClickOK(sender As Object, e As EventArgs) Handles ucrBase.ClickOk
+    'Dim clsSaveFunction As New RFunction
+    'Dim clsDeleteFunction As New RFunction
+    'Dim strImageLocation As String
+    'clsSaveFunction.SetRCommand("ggsave")
+    'If file R_Instat_Temp__Graphs is not there, create it... Where do we do this ? In setup method ? For the moment it's on frmMain Load
+    'frmMain.clsRLink.rtbOutput.CreateTempDirectory()
+    'Need to add ggsave as a Secondary RCommand on every grph dialogue.
+    'Need to edit RMethods producing ggplots to always ggsave in that file as well... Need to find a smart way to name things.
+    'strImageLocation = IO.Path.GetTempPath() & "R_Instat_Temp_Graphs/" & ucrSaveGraph.strGraphName & ".jpg"
+    'clsSaveFunction.AddParameter("filename", Chr(34) & strImageLocation.Replace("\", "/") & Chr(34))
+    'frmMain.clsRLink.RunScript(clsSaveFunction.ToScript(), strComment:="Temporarily saving the image of the last ggplot grph in the temp directory R_Instat_Temp_Graphs.")
+    'frmMain.clsRLink.rtbOutput.DisplayGraph(strImageLocation)
+    'clsDeleteFunction.SetRCommand("unlink")
+    'clsDeleteFunction.AddParameter(strParameterName:="FileName", strParameterValue:=Chr(34) & strImageLocation.Replace("\", "/") & Chr(34), bIncludeArgumentName:=False)
+    'frmMain.clsRLink.RunScript(clsDeleteFunction.ToScript(), strComment:="Deleting graph file from the temp file.")
+    'End Sub
 End Class

instat/dlgOneVarUseModel.vb

@@ -188,7 +188,7 @@ Public Class dlgOneVarUseModel
 
     Private Sub ucrBase_BeforeClickOk(sender As Object, e As EventArgs) Handles ucrBase.BeforeClickOk
         If chkProduceBootstrap.Checked Then
-            frmMain.clsRLink.RunScript(clsRbootFunction.ToScript(), bReturnOutput:=2)
+            frmMain.clsRLink.RunScript(clsRbootFunction.ToScript(), iCallType:=2)
         End If
     End Sub