Attribute VB_Name = "Module1"
'utility definitions for J OLE object
'
'J Object: js
'
'  declare as:  Public js As New JEXEServer
'          or:  Public js As New JDLLServer
'          or:  Public js As Object
'  the exact declaration allows most efficient execution
'  but the declaration as Object allows runtime choice
'
'  set js As New [library.]class
'    library is JEXE or JDLL
'    class is JEXEServer or JDLLServer
'    library is not required if class is unique
'    e.g.  Set js = New jexe.JEXEServer
'          Set js = New JEXEServer
'    can also use createobject:
'    e.g.  Set js = createobject("JEXEServer")
'    New is more efficient than createobject
'
'User functions:
'  jdisplay     display result from J
'  jdo          execute J expression, display any error
'  jget         get name as variant from J, display any error
'  jgetb        jget+b
'  jgets        get name as string from J, display any error
'  jgetbs       jgets+b
'  jinit        standard initialization
'
'Utilities:
'  getrank    get rank of J result

Public js As Object

Public Sub jdisplay(y As Variant, t As Object)
Dim rank As Long
rank = getrank(y)
t = ""
If VarType(y) = vbString Then
  t = y
  Exit Sub
End If
If rank = 0 Then
  t = y
ElseIf rank = 1 Then
  For i = 0 To UBound(y, 1)
    t = t & " " & y(i)
  Next i
ElseIf rank = 2 Then
  For i = 0 To UBound(y, 1)
    For j = 0 To UBound(y, 2)
      t = t & " " & y(i, j)
    Next j
    t = t & vbCrLf
  Next i
ElseIf rank = 3 Then
For i = 0 To UBound(y, 1)
  For j = 0 To UBound(y, 2)
    For k = 0 To UBound(y, 3)
      t = t & " " & y(i, j, k)
    Next k
    t = t & vbCrLf
  Next j
  t = t & vbCrLf
Next i
End If
End Sub

Public Function jdo(txt As String) As Integer
'execute sentence, return error code
Dim v As Variant
jdo = js.Do(txt)
If jdo Then
  js.ErrorText jdo, v
  MsgBox v
End If
End Function

Public Function jget(txt As String) As Variant
ec = js.Get(txt, X)
If ec Then
  js.ErrorText ec, X
  MsgBox X
End If
jget = X
End Function
Public Function jgetb(txt As String) As Variant
ec = js.GetB(txt, X)
If ec Then
  js.ErrorText ec, X
  MsgBox X
End If
jgetb = X
End Function

Public Function jgets(txt As String) As String
Dim res$
ec = js.Get(txt, X)
If ec Then
  js.ErrorText ec, X
  MsgBox X
End If
For i = 0 To UBound(X)
  res = res + Chr(X(i))
Next
jgets = res
End Function

Public Function jgetbs(txt As String) As String
Dim res$
ec = js.GetB(txt, X)
If ec Then
  js.ErrorText ec, X
  MsgBox X
End If
For i = 0 To UBound(X)
  res = res + Chr(X(i))
Next
jgetbs = res
End Function

' J initialization
Public Sub jinit(n As Integer)
' if DLL, create jsystempath, then load stdlib and colib:
If n = 0 Then
  Set js = New JDLLServer
  jdo "jsystempath_z_=: (_11 }. 1!:45 '')&,"
  jdo "0!:0 < jsystempath 'system\main\stdlib.ijs'"
  jdo "0!:0 < jsystempath 'system\main\colib.ijs'"
' if EXE, load profile:
Else
  Set js = New JEXEServer
  js.Quit
  jdo "0!:0 < 1!:45''"
  jdo "jsystempath_z_=: (_11 }. 1!:45 '')&,"
End If
End Sub

Public Function getrank(v As Variant) As Long
On Error GoTo Err
For getrank = 0 To 30
  X = UBound(v, getrank + 1)
Next getrank
Err:
End Function
