Imports System.IO
Imports Mosel
' Example of working with models and accessing Mosel dynamic libraries
Module ExLib
Public Sub RunExLib(ByVal Log As TextWriter)
Dim mosel As XPRM
Dim models(2) As XPRMModel
' Initialise Mosel
mosel = XPRM.Init
' Load the BIM files
models(0) = mosel.LoadModel("Models/burglari.bim")
models(1) = mosel.LoadModel("Models/chess2.bim")
models(2) = mosel.LoadModel("Models/trans.bim")
Log.WriteLine("Models loaded")
' Display basic information about the models
Dim model As XPRMModel
For Each model In models
Log.WriteLine(" {0}: {1} ({2}, '{3}' size:{4})", _
model.Number, model.Name, model.SysComment, _
model.UserComment, model.Size)
Next
Log.WriteLine()
' Enumerate all loaded modules and display information
Log.WriteLine("Additional libraries loaded:")
Dim mo As XPRMModule
For Each mo In mosel.Modules
Log.WriteLine( _
" {0} (version {1}) used by {2} model(s)", _
mo.Name, mo.Version, mo.NumberOfReferences)
Next
End Sub
End Module
|
Imports System.IO
Imports Mosel
' Displays the contents of a model
Module DispMod
Public Sub RunDispMod(ByVal ModName As String, ByVal Log As TextWriter)
Dim mosel As XPRM
Dim model As XPRMModel
Dim proc As XPRMProcedure
' Initialize Mosel and load the model
mosel = XPRM.Init
Log.WriteLine("Loading model {0}", ModName)
model = mosel.LoadModel(ModName)
Log.WriteLine()
' List model parameters
Dim p As XPRMParameter
Log.WriteLine("Model parameters:")
For Each p In model.Parameters
Log.WriteLine(" {0}", p.Name)
Next
Log.WriteLine()
' List symbols
Log.WriteLine("Symbols:")
Dim symb As XPRMIdentifier
For Each symb In model.Identifiers
Select Case symb.StructCode
Case XPRMVarStruct.CONST ' Constant: display value
Log.WriteLine(" {0}={1}", symb.Name, CType(symb, XPRMConstant).Value)
Case XPRMVarStruct.REF ' Reference: display type
Log.WriteLine(" {0}: {1}", symb.Name, symb.TypeName)
Case XPRMVarStruct.ARRAY ' Array: display type
Log.WriteLine(" {0}: array of {1}", symb.Name, symb.TypeName)
Case XPRMVarStruct.SET ' Set: display type
Log.WriteLine(" {0}: set of {1}", symb.Name, symb.TypeName)
Case XPRMVarStruct.PROC ' Subroutine
proc = CType(symb, XPRMProcedure)
Do ' look for all overloading procedures/functions
dispProcFct(proc, Log) ' display the prototype
proc = proc.Next
Loop While (Not proc Is Nothing)
Case Else ' Unknown
Log.WriteLine(" {0}: ?", symb.Name)
End Select
Next
End Sub
' Display a prototype from a signature
Private Function dispProcFct(ByVal proc As XPRMProcedure, ByVal log As TextWriter)
Dim parms() As Char
Dim i As Integer
If (proc.TypeCode <> XPRMVarType.NOT) Then
Log.Write(" function {0}", proc.Name)
Else
Log.Write(" procedure {0}", proc.Name)
End If
If (proc.NbParameters > 0) Then
Log.Write("(")
parms = proc.ParameterTypes.ToCharArray
i = 0
Do While (i < parms.Length)
If (i > 0) Then
Log.Write(",")
End If
i = dispType(i, parms, Log) + 1
Loop
Log.Write(")")
End If
If (proc.TypeCode <> XPRMVarType.NOT) Then
Log.Write(":{0}", proc.TypeName)
End If
Log.WriteLine()
End Function
' Display a type name from a signature
Private Function dispType(ByVal i As Integer, ByVal parms As Char(), ByVal log As TextWriter)
Dim j As Integer
Select Case parms(i)
Case "i"
log.Write("integer")
Case "r"
log.Write("real")
Case "s"
log.Write("string")
Case "b"
log.Write("boolean")
Case "v"
log.Write("mpvar")
Case "c"
log.Write("linctr")
Case "I"
log.Write("range")
Case "a"
log.Write("array")
Case "e"
log.Write("set")
Case "|"
i = i + 1
Do
log.Write(parms(i))
i = i + 1
Loop While (parms(i) <> "|")
Case "!"
i = i + 1
Do
log.Write(parms(i))
i = i + 1
Loop While (parms(i) <> "!")
Case "A"
log.Write("array (")
i = i + 1
j = i
Do While (parms(i) <> ".")
If (j <> i) Then
log.Write(",")
End If
i = dispType(i, parms, log) + 1
Loop
log.Write(") of ")
i = dispType(i + 1, parms, log)
Case "E"
log.Write("set of ")
i = i + 1
i = dispType(i, parms, log)
Case Else
log.Write("?")
End Select
Return i
End Function
End Module
|
Imports System.IO
Imports Mosel
' Displays information about a Mosel DSO module
Module DispDso
Public Sub RunDispDso(ByVal ModName As String, ByVal log As TextWriter)
log.WriteLine("Will interrogate module '{0}'", ModName)
Dim mosel As XPRM
Dim ourModule As XPRMModule
' Initialise Mosel
mosel = XPRM.Init
' Load the module
ourModule = mosel.LoadModule(ModName)
' Output basic information about the module
log.WriteLine("Module '{0}', version {1}", ourModule.Name, ourModule.Version)
If ((Not ourModule.Certificate Is Nothing) And (ourModule.Certificate.Length > 0)) Then
log.WriteLine(" ({0})", ourModule.Certificate)
Else
log.WriteLine("")
End If
log.WriteLine()
' Output a list of types defined within the module
log.WriteLine("Types:")
Dim nt As XPRMNativeType
For Each nt In ourModule.Types
log.WriteLine(" {0} (", nt.Name)
If (nt.HasCreate) Then
log.Write("create")
End If
If (nt.HasDelete) Then
log.Write(",delete")
End If
If (nt.HasToString) Then
log.Write(",tostring")
End If
If (nt.HasPRTBL) Then
log.Write("+")
End If
If (nt.HasFromString) Then
log.Write(",fromstring")
End If
log.WriteLine()
Next
log.WriteLine()
' List of control parameters
log.WriteLine("Control Parameters:")
Dim p As XPRMParameter
For Each p In ourModule.Parameters
log.Write(" {0}: {1} (", p.Name, p.TypeName)
If (Not p.Description Is Nothing And p.Description.Length > 0) Then
log.Write("{0},", p.Description)
End If
log.WriteLine(rwstatus(p) + ")")
Next
log.WriteLine()
' List of subroutines
log.WriteLine("Procedures and Functions:")
Dim proc As XPRMProcedure
For Each proc In ourModule.Procedures
dispProcFct(proc, log)
Next
log.WriteLine()
' List of IO drivers
log.WriteLine("I/O drivers:")
Dim iod As XPRMIODriver
For Each iod In ourModule.IODrivers
log.WriteLine(" {0}:{1}", iod.Name, IIf(Not iod.Info Is Nothing, iod.Info, ""))
Next
End Sub
' Return the r/w status of a control parameter
Private Function rwstatus(ByVal p As XPRMParameter) As String
If (p.IsReadable) Then
If (p.IsWriteable) Then
Return "r/w"
Else
Return "r"
End If
Else
If (p.IsWriteable) Then
Return "w"
Else
Return "?"
End If
End If
End Function
' Display a prototype from a signature
Private Function dispProcFct(ByVal proc As XPRMProcedure, ByVal log As TextWriter)
Dim parms() As Char
Dim i As Integer
If (proc.TypeCode <> XPRMVarType.NOT) Then
log.Write(" function {0}", proc.Name)
Else
log.Write(" procedure {0}", proc.Name)
End If
If (proc.NbParameters > 0) Then
log.Write("(")
parms = proc.ParameterTypes.ToCharArray
i = 0
Do While (i < parms.Length)
If (i > 0) Then
log.Write(",")
End If
i = dispType(i, parms, log) + 1
Loop
log.Write(")")
End If
If (proc.TypeCode <> XPRMVarType.NOT) Then
log.Write(":{0}", proc.TypeName)
End If
log.WriteLine()
End Function
' Display a type name from a signature
Private Function dispType(ByVal i As Integer, ByVal parms As Char(), ByVal log As TextWriter)
Dim j As Integer
Select Case parms(i)
Case "i"
log.Write("integer")
Case "r"
log.Write("real")
Case "s"
log.Write("string")
Case "b"
log.Write("boolean")
Case "v"
log.Write("mpvar")
Case "c"
log.Write("linctr")
Case "I"
log.Write("range")
Case "a"
log.Write("array")
Case "e"
log.Write("set")
Case "|"
i = i + 1
Do
log.Write(parms(i))
i = i + 1
Loop While (parms(i) <> "|")
Case "!"
i = i + 1
Do
log.Write(parms(i))
i = i + 1
Loop While (parms(i) <> "!")
Case "A"
log.Write("array (")
i = i + 1
j = i
Do While (parms(i) <> ".")
If (j <> i) Then
log.Write(",")
End If
i = dispType(i, parms, log) + 1
Loop
log.Write(") of ")
i = dispType(i + 1, parms, log)
Case "E"
log.Write("set of ")
i = i + 1
i = dispType(i, parms, log)
Case Else
log.Write("?")
End Select
Return i
End Function
End Module
|
