' *** Calls Lingo to optimize a simple staff scheduling model ***

Imports System.Runtime.InteropServices

Partial Class _Default
   Inherits System.Web.UI.Page

   Protected Sub btnSolve_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSolve.Click
      Solve()
   End Sub

   Protected Sub Solve()

      Dim dNeeds(7), dStart(7), dOnDuty(7), dObj(1), dStatus(1) As Double
      Dim nErr, nPointers, nStatus As Integer
      Dim env As IntPtr

      ' Create the lingo object
      Dim lng As New Lingo

      ' Create callback data object
      Dim cbData As New CallbackData()

      ' Clear label error
      lblError.Text = ""

      ' Load staffing needs from text boxes
      Try
         dNeeds(0) = txtNeedsMon.Text
         dNeeds(1) = txtNeedsTue.Text
         dNeeds(2) = txtNeedsWed.Text
         dNeeds(3) = txtNeedsThu.Text
         dNeeds(4) = txtNeedsFri.Text
         dNeeds(5) = txtNeedsSat.Text
         dNeeds(6) = txtNeedsSun.Text
      Catch
         lblError.Text = "Input a positive, integer value for each day."
         Exit Sub
      End Try

      ' Create a lingo environment
      env = Lingo.LScreateEnvLng()
      If (env = 0) Then
         lblError.Text = "Unable to create Lingo environment."
         Exit Sub
      End If

      ' Create a log file (useful for debugging)
      nErr = Lingo.LSopenLogFileLng(env, "\lingo64_18\lingo.log")
      If (nErr <> 0) Then
         lblError.Text = "Unable to open log file."
         GoTo ErrExit
      End If

      ' .NET garbage collection may move arrays around.  We must
      ' pin them in memory until lingo is through with them.

      ' Pass lingo a pointer to the staffing needs
      Dim Need As New clsArray
      Need.dArray = dNeeds
      Dim pdNeed As New IntPtr
      pdNeed = Marshal.AllocHGlobal(Marshal.SizeOf(dNeeds(0)) * dNeeds.Length())
      Marshal.StructureToPtr(Need, pdNeed, False)
      nErr = Lingo.LSsetPointerLng(env, pdNeed, nPointers)
      If (nErr <> 0) Then
         lblError.Text = "Unable to pass Needs array."
         GoTo ErrExit
      End If

      ' Pass lingo a pointer to the array for storing the staffing starts
      Dim Start As New clsArray
      Dim pdStart As New IntPtr
      pdStart = Marshal.AllocHGlobal(Marshal.SizeOf(dStart(0)) * dStart.Length())
      Marshal.StructureToPtr(Start, pdStart, False)
      nErr = Lingo.LSsetPointerLng(env, pdStart, nPointers)
      If (nErr <> 0) Then
         lblError.Text = "Unable to pass Start array."
         GoTo ErrExit
      End If

      ' A pointer for storing the on duty count for each day
      Dim OnDuty As New clsArray
      Dim pdOnDuty As New IntPtr
      pdOnDuty = Marshal.AllocHGlobal(Marshal.SizeOf(dOnDuty(0)) * dOnDuty.Length())
      Marshal.StructureToPtr(OnDuty, pdOnDuty, False)
      nErr = Lingo.LSsetPointerLng(env, pdOnDuty, nPointers)
      If (nErr <> 0) Then
         lblError.Text = "Unable to pass OnDuty address."
         GoTo ErrExit
      End If

      ' A pointer to the where the objective value will be stored
      Dim Obj As New clsScalar
      Dim pdObj As New IntPtr
      pdObj = Marshal.AllocHGlobal(Marshal.SizeOf(dObj(0)) * dObj.Length())
      Marshal.StructureToPtr(Obj, pdObj, False)
      nErr = Lingo.LSsetPointerLng(env, pdObj, nPointers)
      If (nErr <> 0) Then
         lblError.Text = "Unable to pass objective address."
         GoTo ErrExit
      End If

      ' A pointer to where the solution status will be stored
      Dim Status As New clsScalar
      Dim pdStatus As New IntPtr()
      pdStatus = Marshal.AllocHGlobal(Marshal.SizeOf(dStatus(0)) * dStatus.Length())
      Marshal.StructureToPtr(Status, pdStatus, False)
      dStatus(0) = -1
      Status.dScalar = dStatus
      nErr = Lingo.LSsetPointerLng(env, pdStatus, nPointers)
      If (nErr <> 0) Then
         lblError.Text = "Unable to pass status address."
          GoTo ErrExit
      End If

      ' Allocate area in the unmanaged heap for user data
      Dim pMyData As New IntPtr()
      pMyData = Marshal.AllocHGlobal(Marshal.SizeOf(cbData))
      Marshal.StructureToPtr(cbData, pMyData, False)

      ' Let Lingo know we have a callback function (note: this step 
      ' is optional)
      Dim cb As Lingo.typCallbackSolver
      Dim clscb As New clsCallback
      cb = AddressOf clscb.MySolverCallback
      nErr = Lingo.LSsetCallbackSolverLng(env, cb, pMyData)

      ' Here is the script we want LINGO to run. 
      Dim cScript As String
      cScript = "take \lingo64_18\samples\staffptr.lng" & Chr(10)

      ' Add commands to solve the model and exit the script processor
      'cScript = cScript & "go" & Chr(10) & "quit" & Chr(10) & Chr(0)
      cScript = cScript & Chr(10) & "gen" & Chr(10) & "go" & Chr(10) & "quit" & Chr(10) & Chr(0)

      ' Run the script
      nErr = Lingo.LSexecuteScriptLng(env, cScript)
      If (nErr <> 0) Then
         lblError.Text = "LSExecute error code: " + nErr.ToString
         GoTo ErrExit
      End If

      ' Marshal callback data to local managed structure
      Marshal.PtrToStructure(pMyData, cbData)

      ' Free up the unmanaged heap space
      Marshal.FreeHGlobal(pMyData)

      ' Close log file
      nErr = Lingo.LScloseLogFileLng(env)
      If (nErr <> 0) Then
         lblError.Text = "Unable to close log."
         GoTo ErrExit
      End If

      ' Marshal the staff starting array back to the managed structure
      Marshal.PtrToStructure(pdStart, Start)
      dStart = Start.dArray
      Marshal.PtrToStructure(pdOnDuty, OnDuty)
      dOnDuty = OnDuty.dArray
      Marshal.PtrToStructure(pdObj, Obj)
      dObj = Obj.dScalar
      Marshal.PtrToStructure(pdStatus, Status)
      dStatus = Status.dScalar
      nStatus = dStatus(0)

      ' Place results on the page
      lblStartMon.Text = dStart(0)
      lblStartTue.Text = dStart(1)
      lblStartWed.Text = dStart(2)
      lblStartThu.Text = dStart(3)
      lblStartFri.Text = dStart(4)
      lblStartSat.Text = dStart(5)
      lblStartSun.Text = dStart(6)

      lblOnDutyMon.Text = dOnDuty(0)
      lblOnDutyTue.Text = dOnDuty(1)
      lblOnDutyWed.Text = dOnDuty(2)
      lblOnDutyThu.Text = dOnDuty(3)
      lblOnDutyFri.Text = dOnDuty(4)
      lblOnDutySat.Text = dOnDuty(5)
      lblOnDutySun.Text = dOnDuty(6)

      lblTotal.Text = dObj(0)

      lblCallbacks.Text = "Callbacks: " & cbData.nCallbacks

      If (nErr <> 0 Or nStatus <> 0) Then
         lblError.Text = "Unable to solve."
         GoTo ErrExit
      End If

      ' Free memory in global heap
      Marshal.FreeHGlobal(pdNeed)
      Marshal.FreeHGlobal(pdStart)
      Marshal.FreeHGlobal(pdOnDuty)
      Marshal.FreeHGlobal(pdObj)
      Marshal.FreeHGlobal(pdStatus)

ErrExit:
      ' Release the lingo object
        Lingo.LSdeleteEnvLng(env)

   End Sub

End Class

<StructLayout(LayoutKind.Sequential)> _
Public Class clsArray
   <MarshalAs(UnmanagedType.ByValArray, SizeConst:=7)> _
   Public dArray As Double()
End Class

<StructLayout(LayoutKind.Sequential)> _
Public Class clsScalar
   <MarshalAs(UnmanagedType.ByValArray, SizeConst:=1)> _
   Public dScalar As Double()
End Class

' Our data structure to pass to the callback function
<StructLayout(LayoutKind.Sequential)> _
Public Class CallbackData
    Public nCallbacks As Integer = 0
    Public nIterations As Integer = 0
    Public dObjective As Double = 0
End Class

Public Class clsCallback
    Public Function MySolverCallback(ByVal pModel As IntPtr, _
     ByVal nReserved As IntPtr, ByVal pMyData As IntPtr) As Integer

        Dim nErr As Integer

         Dim cbData As New CallbackData()

        ' Copy the user data in the unmanaged code into a local structure
        ' Marshal callback data to local managed structure
        Marshal.PtrToStructure(pMyData, cbData)

        ' Increment the number of calls to the callback function
        cbData.nCallbacks = cbData.nCallbacks + 1

        ' Request iteration count and objective from Lingo
        nErr = Lingo.LSgetCallbackInfoLng(pModel, _
         Lingo.LScallbackInfoCodeLng.LS_IINFO_ITERATIONS_LNG, cbData.nIterations)
        nErr = Lingo.LSgetCallbackInfoLng(pModel, _
         Lingo.LScallbackInfoCodeLng.LS_DINFO_OBJECTIVE_LNG, cbData.dObjective)


        If cbData.nCallbacks Mod 20 = 0 Then
           Console.WriteLine("In callback: calls = " & cbData.nCallbacks)
        End If

        ' Marshal user data back to unmanaged heap
        Marshal.StructureToPtr(cbData, pMyData, False)

    End Function
End Class