Merge pull request #63 from africanmathsinitiative/master

Pulling changes from the main

instat/clsRLink.vb

@@ -1,19 +1,19 @@
-' Instat+R
-' Copyright (C) 2015
-'
-' This program is free software: you can redistribute it and/or modify
-' it under the terms of the GNU General Public License as published by
-' the Free Software Foundation, either version 3 of the License, or
-' (at your option) any later version.
-'
-' This program is distributed in the hope that it will be useful,
-' but WITHOUT ANY WARRANTY; without even the implied warranty of
-' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-' GNU General Public License for more details.
-'
-' You should have received a copy of the GNU General Public License k
-' along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
+' Instat+R
+' Copyright (C) 2015
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT ANY WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+' GNU General Public License for more details.
+'
+' You should have received a copy of the GNU General Public License k
+' along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
 Imports RDotNet
 
 Public Class RLink
@@ -30,10 +30,34 @@ Public Class RLink
     Public bClimateObjectExists As Boolean = False
     Public bInstatObjectExists As Boolean = False
     Public bClimsoftLinkExists As Boolean = False
-
+    'sets the font for the strScript
+    Public fScript As Font = New Font(txtOutput.Font.FontFamily, txtOutput.Font.Size)
+    Public clrScript As Color = Color.Black
+    'sets the font for the strOutput
+    Public fOutput As Font = New Font(txtOutput.Font.FontFamily, txtOutput.Font.Size)
+    Public clrOutput As Color = Color.Blue
+    'sets the font for the Comments
+    Public fComments As Font = New Font(txtOutput.Font.FontFamily, txtOutput.Font.Size)
+    Public clrComments As Color = Color.Green
+
     Public Sub New(Optional bWithInstatObj As Boolean = False, Optional bWithClimsoft As Boolean = False)
     End Sub
 
+    Public Sub setFormatOutput(tempFont As Font, tempColor As Color)
+        fOutput = tempFont
+        clrOutput = tempColor
+    End Sub
+
+    Public Sub setFormatScript(tempFont As Font, tempColor As Color)
+        fScript = tempFont
+        clrScript = tempColor
+    End Sub
+
+    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
@@ -94,20 +118,28 @@ Public Class RLink
         Return lstNextDefaults
     End Function
 
-    Public Sub RunScript(strScript As String, Optional bReturnOutput As Integer = 0)
+    Public Sub RunScript(strScript As String, Optional bReturnOutput As Integer = 0, Optional strComment As String = "")
         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
         strOutput = ""
         Try
+            If strComment <> "" Then
+                strScriptWithComment = "# " & strComment & vbCrLf & strScript
+            Else
+                strScriptWithComment = strScript
+            End If
             If bLog Then
-                txtLog.Text = txtLog.Text & strScript & vbCrLf
+                txtLog.Text = txtLog.Text & strScriptWithComment & vbCrLf
             End If
             If bOutput Then
-                txtOutput.Text = txtOutput.Text & strScript & vbCrLf
-                'input format here
+                If strComment <> "" Then
+                    AppendText(txtOutput, clrComments, fComments, strScriptWithComment & vbCrLf)
+                End If
+                AppendText(txtOutput, clrScript, fScript, strScript & vbCrLf)
             End If
             If bReturnOutput = 0 Then
                 clsEngine.Evaluate(strScript)
@@ -127,14 +159,31 @@ Public Class RLink
                 strOutput = strOutput & strTemp & vbCrLf
             End If
             If bOutput Then
-                txtOutput.Text = txtOutput.Text & strOutput
+                'txtOutput.Text = txtOutput.Text & strOutput
                 'output format here
+                AppendText(txtOutput, clrOutput, fOutput, strOutput)
             End If
         Catch
             MsgBox(strScript)
         End Try
         frmMain.clsGrids.UpdateGrids()
     End Sub
+
+    Private Sub AppendText(box As RichTextBox, color As Color, font As Font, text As String)
+        Dim iStart As Integer = box.TextLength
+        Dim iEnd As Integer
+
+        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
+    End Sub
 
 
     Public Function GetData(strLabel As String) As DataFrame

instat/clsRSyntax.vb

@@ -34,11 +34,8 @@ Public Class RSyntax
         bUseBaseOperator = False
     End Sub
 
-    Public Sub SetOperation(strOp As String, Optional ByRef clsROp As ROperator = Nothing)
-        If clsROp Is Nothing Then
-            clsROp = clsBaseOperator
-        End If
-        clsROp.SetOperation(strOp)
+    Public Sub SetOperation(strOp As String)
+        clsBaseOperator.SetOperation(strOp)
         bUseBaseFunction = False
         bUseBaseOperator = True
     End Sub
@@ -60,6 +57,10 @@ Public Class RSyntax
         clsBaseFunction.AddParameter(clsRParam)
     End Sub
 
+    Public Sub SetOperatorParameter(bSetLeftNotRight As Boolean, Optional clsParam As RParameter = Nothing, Optional clsRFunc As RFunction = Nothing, Optional clsOp As ROperator = Nothing)
+        clsBaseOperator.SetParameter(bSetLeftNotRight, clsParam, clsRFunc, clsOp)
+    End Sub
+
     Public Sub RemoveParameter(strParameterName As String, Optional ByRef clsFunction As RFunction = Nothing)
         Dim clsParam As New RParameter
 
@@ -79,18 +80,26 @@ Public Class RSyntax
 
     Public Function GetScript(Optional ByRef clsFunction As RFunction = Nothing, Optional bExcludeAssignedFunctionOutput As Boolean = True) As String
 
-        Dim strTemp As String
+        Dim strTemp As String = ""
 
         If IsNothing(clsFunction) Then
-            clsFunction = clsBaseFunction
-        End If
-
-        strTemp = clsFunction.ToScript(strScript)
-        If bExcludeAssignedFunctionOutput And clsFunction.bIsAssigned Then
-            Return strScript
+            If bUseBaseFunction Then
+                clsFunction = clsBaseFunction
+                strTemp = clsBaseFunction.ToScript(strScript)
+            End If
+            If bUseBaseOperator Then
+                strTemp = clsBaseOperator.ToScript(strScript)
+            End If
         Else
-            Return strScript & strTemp
+            strTemp = clsFunction.ToScript(strScript)
+        End If
+        If bUseBaseFunction Then
+            If bExcludeAssignedFunctionOutput And clsFunction.bIsAssigned Then
+                Return strScript
+                Exit Function
+            End If
         End If
+        Return strScript & strTemp
 
     End Function