egtbeamwall/EgtBEAMWALL.Core/Integration/CalcIntegration.vb

Imports System.IO
Imports System.Threading
Imports System.Globalization
Imports EgtUILib
Imports EgtWPFLib5
Imports EgtBEAMWALL.Core.ConstBeam
Imports EgtBEAMWALL.Core

Public Module CalcIntegration

   Private _thread As System.Threading.Thread

   Public Event Calc_Ended As EventHandler(Of CalcEndEventArgs)
   Public Event Calc_ProcessResult As EventHandler(Of CalcResultEventArgs)
   Public Event Calc_ProcessEnd As EventHandler(Of CalcProcessEndEventArgs)

   Public Enum CmdType As Integer
      GENERATE = 0
      MODIFY = 1
      SIMULATE = 2
      CHECK = 3
      CHECKGEN = 4
      POINT_CLOUD = 5
      RAWPART = 6
   End Enum

   Private Structure MyProc
      Public bEnable As Boolean
      Public Proc As Process
      Public nBar As Integer
   End Structure

   Private m_MaxCamInstances As Integer = 1
   Public Sub SetMaxCamInstances(value As Integer)
      m_MaxCamInstances = value
   End Sub

   Delegate Sub CallbackDlg(dProgress As Double, sProgress As String, ByRef bCancel As Boolean)

   Public Sub Run(vBar As Bar(), sProjDirPath As String, callback As CallbackDlg)
      _thread = New Thread(Sub()
                              DoJob(vBar, sProjDirPath, callback)
                           End Sub)
      _thread.Start()
   End Sub

   Private Sub DoJob(vBar As Bar(), sProjDirPath As String, callback As CallbackDlg)
      Dim bCancel As Boolean = False
      callback(0, "Init", bCancel)

      ' creo progetti a seconda del tipo
      For Each Bar In vBar
         If Bar.nProgramPage = ProjectType.PROJ Then
            Bar.sBarPath = CreateNewProjectFromPart(Bar.nBarId, sProjDirPath)
         ElseIf Bar.nProgramPage = ProjectType.PROD Then
            Bar.sBarPath = CreateNewProjectFromMachGroup(Bar.nBarId, sProjDirPath)
         End If
      Next

      Dim bIsSimulation As Boolean = False
      ' se sono in simulazione
      If vBar.Count > 0 AndAlso vBar(0).nCmdType = CmdType.SIMULATE Then
         bIsSimulation = True
         callback(0, "Simulation opened", bCancel)
      Else
         callback(0.1, "", bCancel)
      End If

      Dim ExePath As String = String.Empty
      GetMainPrivateProfileString(S_BEAM, K_CALCPATH, "", ExePath)
      ' Numero di barre 
      Dim numBars As Integer = vBar.Count
      If numBars = 0 Then Return

      ' Numero di core logici da utilizzare (minimo tra presenti sul PC e imposti da INI)
      Dim nMaxThread As Integer = Math.Min(Environment.ProcessorCount, m_MaxCamInstances)

      ' Frazione di avanzamento del lavoro (in piu)
      Dim dProgress As Double = 0
      'indice incremento progress durante calcolo barra
      Dim nPgsCurrBar As Integer = 0
      Dim nPgsClock As Integer = 0


      ' Lancio in parallelo più processi (senza superare il numero di core logici presenti)
      Dim vProc As MyProc() = New MyProc(nMaxThread - 1) {}
      For j As Integer = 0 To nMaxThread - 1
         vProc(j).nBar = -1
         vProc(j).bEnable = True
      Next

      ' Processo i Btl in parallelo
      Dim nCurrBar As Integer = 0
      Dim nDoneBar As Integer = 0
      Dim nShiftBar As Integer = 0
      Dim nActProc As Integer = 0

      Dim bAllKO As Boolean

      While nCurrBar < numBars + nShiftBar OrElse nActProc > 0

         For j As Integer = 0 To nMaxThread - 1
            If Not vProc(j).bEnable Then Continue For
            Dim bDone As Boolean = False

            If vProc(j).nBar = -1 Then

               If nCurrBar < numBars + nShiftBar Then

                  If vBar(nCurrBar).bBarOk Then
                     vProc(j).Proc = New Process()
                     vProc(j).Proc.StartInfo.FileName = ExePath
                     vProc(j).Proc.StartInfo.Arguments = """" & vBar(nCurrBar).sBarPath & """ " &
                                                         """" & vBar(nCurrBar).nProjType & """ " &
                                                         """" & vBar(nCurrBar).nMachineName & """ " & vBar(nCurrBar).nCmdType
                     vProc(j).Proc.StartInfo.UseShellExecute = False

                     If vProc(j).Proc.Start() Then
                        vProc(j).nBar = nCurrBar
                        nCurrBar += 1
                        nActProc += 1
                     End If
                  Else
                     If vBar(nCurrBar).nCmdType = CmdType.CHECK OrElse vBar(nCurrBar).nCmdType = CmdType.CHECKGEN Then
                        RaiseEvent Calc_ProcessResult(Nothing, New CalcResultEventArgs(vBar(nCurrBar))) 'ProcessResults(vBar(nCurrBar))
                     ElseIf vBar(nCurrBar).nCmdType = CmdType.GENERATE Then
                        RaiseEvent Calc_ProcessEnd(Nothing, New CalcProcessEndEventArgs(vBar(nCurrBar))) 'ProcessResults(vBar(nCurrBar))
                     End If
                     bDone = True
                     nCurrBar += 1
                  End If
               End If
            Else

               If vProc(j).Proc.HasExited Then
                  ' se terminato con successo
                  If vProc(j).Proc.ExitCode = 0 Then
                     ' salvo il risultato
                     If vBar(vProc(j).nBar).nCmdType = CmdType.CHECK OrElse vBar(vProc(j).nBar).nCmdType = CmdType.CHECKGEN Then
                        RaiseEvent Calc_ProcessResult(Nothing, New CalcResultEventArgs(vBar(vProc(j).nBar))) ' ProcessResults(vBar(vProc(j).nBar))
                     ElseIf vBar(vProc(j).nBar).nCmdType = CmdType.GENERATE Then
                        RaiseEvent Calc_ProcessEnd(Nothing, New CalcProcessEndEventArgs(vBar(vProc(j).nBar))) 'ProcessResults(vBar(nCurrBar))
                     End If
                     bDone = True
                     vProc(j).nBar = -1
                     nActProc -= 1
                     ' se superato il numero di processi eseguibili in parallelo
                  ElseIf vProc(j).Proc.ExitCode = 1 Then
                     ' aggiungo il pezzo in coda
                     If numBars + nShiftBar < numBars + nMaxThread Then
                        vBar(numBars + nShiftBar) = vBar(vProc(j).nBar)
                        nShiftBar += 1
                     End If
                     ' disabilito il processo
                     vProc(j).bEnable = False
                     vProc(j).nBar = -1
                     nActProc -= 1
                     ' altrimenti (errore generico di esecuzione)
                  Else
                     ' salvo il risultato
                     If vBar(vProc(j).nBar).nCmdType = CmdType.CHECK OrElse vBar(vProc(j).nBar).nCmdType = CmdType.CHECKGEN Then
                        RaiseEvent Calc_ProcessResult(Nothing, New CalcResultEventArgs(vBar(vProc(j).nBar))) ' ProcessResults(vBar(vProc(j).nBar))
                     ElseIf vBar(vProc(j).nBar).nCmdType = CmdType.GENERATE Then
                        RaiseEvent Calc_ProcessEnd(Nothing, New CalcProcessEndEventArgs(vBar(vProc(j).nBar))) 'ProcessResults(vBar(nCurrBar))
                     End If
                     bDone = True
                     vProc(j).nBar = -1
                     nActProc -= 1
                  End If
               Else
                  vProc(j).Proc.Refresh()
               End If
            End If

            If bDone Then
               ' se non sono in simulazione
               If bIsSimulation Then
                  callback(0, "Simulation closing", bCancel)
               Else
                  ' Dialog con Progress Bar
                  nDoneBar += 1
                  dProgress = 1 / numBars * nDoneBar
                  Dim sProg As String = (dProgress * 100).ToString("F1", CultureInfo.InvariantCulture)
                  callback(dProgress, " Progress: " & sProg & "% Count: " & nDoneBar & " / " & numBars, bCancel)
               End If
               If bCancel Then
                  ' fine
                  callback(1, "", bCancel)
                  ' riabilito interfaccia
                  RaiseEvent Calc_Ended(Nothing, New CalcEndEventArgs(CalcEndEventArgs.Results.OK))

                  Return
               End If
               nPgsCurrBar = 0
               nPgsClock = 0
            Else
               ' se non sono in simulazione
               If Not bIsSimulation Then
                  ' aggiorno conteggio
                  If nPgsClock >= 100 AndAlso nPgsCurrBar < 149 Then
                     nPgsCurrBar += 1
                     dProgress = 1 / numBars * nDoneBar + 1 / numBars / 150 * nPgsCurrBar
                     Dim sProg As String = (dProgress * 100).ToString("F1", CultureInfo.InvariantCulture)
                     callback(dProgress, " Progress: " & sProg & "% Count: " & nDoneBar & " / " & numBars, bCancel)
                     nPgsClock = 0
                  End If
               End If
            End If
            nPgsClock += 1
            Thread.Sleep(1)
         Next

         ' Verifico che i processi non siano andati tutti in errore
         bAllKO = True

         For j As Integer = 0 To nMaxThread - 1
            If vProc(j).bEnable Then bAllKO = False
         Next

         If bAllKO Then
            Exit While
         End If

         Thread.Sleep(10)
      End While

      Thread.Sleep(300)

      ' se sono in simulazione
      If bIsSimulation Then
         callback(1, "Simulation closed", bCancel)
      Else
         callback(1, "Done", bCancel)
      End If
      ' riabilito interfaccia
      RaiseEvent Calc_Ended(Nothing, New CalcEndEventArgs(If(bAllKO, CalcEndEventArgs.Results.ERROR_, CalcEndEventArgs.Results.OK)))
   End Sub

   Private Function CreateNewProjectFromPart(nPartId As Integer, sProjDirPath As String) As String

      ' Aggiorno identificativi per segnalazione errori
      UpdateCutIdAndTaskId(nPartId)

      ' Disabilito segnalazione modificato
      Dim DisableMgr As New DisableModifiedMgr

      ' Recupero visibilita' pezzo e lo imposto a visibile
      Dim nOldPartMode As Integer
      EgtGetMode(nPartId, nOldPartMode)
      EgtSetMode(nPartId, GDB_MD.STD)

      ' Salvo pezzo nel suo progetto
      Dim bOk As Boolean = False
      Dim nPDN As Integer = 0
      EgtGetInfo(nPartId, BTL_PRT_PDN, nPDN)
      Dim sPartFilePath As String = sProjDirPath & "\" & nPDN.ToString() & ".bwe"
      bOk = EgtSaveObjToFile(nPartId, sPartFilePath, NGE.CMPTEXT)

      ' Ripristino visibilita' pezzo
      EgtSetMode(nPartId, nOldPartMode)

      ' Ripristino stato segnalazione modifica
      DisableMgr.ReEnable()

      Return If(bOk, sPartFilePath, String.Empty)
   End Function

   Private Function CreateNewProjectFromMachGroup(nMachGroupId As Integer, sProjDirPath As String) As String

      ' Aggiorno identificativi per segnalazione errori
      Dim nOldMachGroup As Integer = EgtGetCurrMachGroup()
      If nMachGroupId <> nOldMachGroup Then EgtSetCurrMachGroup(nMachGroupId)
      Dim nRawId As Integer = EgtGetFirstRawPart()
      While nRawId <> GDB_ID.NULL
         If EgtVerifyRawPartPhase(nRawId, 1) Then
            Dim nPartId As Integer = EgtGetFirstPartInRawPart(nRawId)
            While nPartId <> GDB_ID.NULL
               UpdateCutIdAndTaskId(nPartId)
               nPartId = EgtGetNextPartInRawPart(nPartId)
            End While
         End If
         nRawId = EgtGetNextRawPart(nRawId)
      End While
      If nMachGroupId <> nOldMachGroup Then
         If nOldMachGroup <> GDB_ID.NULL Then
            EgtSetCurrMachGroup(nOldMachGroup)
         Else
            EgtResetCurrMachGroup()
         End If
      End If

      ' Salvo gruppo di lavorazione nel suo progetto
      Dim sMachGroupName As String = ""
      EgtGetMachGroupName(nMachGroupId, sMachGroupName)
      Dim sMachGroupFilePath As String = sProjDirPath & "\" & sMachGroupName & ".bwe"
      If EgtSaveObjToFile(nMachGroupId, sMachGroupFilePath, NGE.CMPTEXT) Then
         Return sMachGroupFilePath
      End If
      Return String.Empty
   End Function

   Private Function UpdateCutIdAndTaskId(nPartId As Integer) As Boolean
      ' Assegno Id a CutId per calcoli
      EgtSetInfo(nPartId, "CUTID", nPartId, True)

      ' Assegno TASKID agli outline per calcoli
      Dim nOutLayerId As Integer = EgtGetFirstNameInGroup(nPartId, OUTLINE)
      Dim nOutlineId As Integer = EgtGetFirstInGroup(nOutLayerId)
      While nOutlineId <> GDB_ID.NULL
         ' verifico che sia una feature
         Dim nGRP As Integer
         If EgtGetInfo(nOutlineId, BTL_FTR_GRP, nGRP) Then
            ' verifico se ha un principale
            Dim nMainOffsId As Integer
            If EgtGetInfo(nOutlineId, BTL_FTR_MAINID, nMainOffsId) Then
               ' assegno TASKID alla feature per calcoli
               EgtSetInfo(nOutlineId, "TASKID", nOutlineId + nMainOffsId, True)
            Else
               ' assegno TASKID alla feature per calcoli
               EgtSetInfo(nOutlineId, "TASKID", nOutlineId, True)
            End If
         End If
         nOutlineId = EgtGetNext(nOutlineId)
      End While

      ' Assegno TASKID alle feature per calcoli
      Dim nProcessingId As Integer = EgtGetFirstNameInGroup(nPartId, PROCESSINGS)
      Dim nFeatureId As Integer = EgtGetFirstInGroup(nProcessingId)
      While nFeatureId <> GDB_ID.NULL
         ' verifico che sia una feature
         Dim nGRP As Integer
         If EgtGetInfo(nFeatureId, BTL_FTR_GRP, nGRP) Then
            ' verifico se ha un principale
            Dim nMainOffsId As Integer
            If EgtGetInfo(nFeatureId, BTL_FTR_MAINID, nMainOffsId) Then
               ' assegno TASKID alla feature per calcoli
               EgtSetInfo(nFeatureId, "TASKID", nFeatureId + nMainOffsId, True)
            Else
               ' assegno TASKID alla feature per calcoli
               EgtSetInfo(nFeatureId, "TASKID", nFeatureId, True)
            End If
         End If
         nFeatureId = EgtGetNext(nFeatureId)
      End While
      Return True
   End Function

End Module

Public Class Bar
   'Public piInfo As PatternInfo
   Public nBarState As Integer
   Public nBarId As Integer
   Public sBarPath As String
   Public bBarOk As Boolean
   Public nCmdType As Integer
   Public nProgramPage As ProjectType
   Public nProjType As BWType
   Public nMachineName As String
End Class

Public Class ProcessResult

   Public Enum ProcessResultTypes As Integer
      BAR = 1
      PART = 2
      TASKID = 3
      FALL = 4
      TIME = 5
   End Enum

   Private m_Type As ProcessResultTypes
   Public ReadOnly Property Type As ProcessResultTypes
      Get
         Return m_Type
      End Get
   End Property

   Private m_nCUTID As Integer
   Public ReadOnly Property nCUTID As Integer
      Get
         Return m_nCUTID
      End Get
   End Property

   Private m_nTASKID As Integer
   Public ReadOnly Property nTASKID As Integer
      Get
         Return m_nTASKID
      End Get
   End Property

   Private m_nERR As Integer
   Public ReadOnly Property nERR As Integer
      Get
         Return m_nERR
      End Get
   End Property

   Private m_sMSG As String
   Public ReadOnly Property sMSG As String
      Get
         Return m_sMSG
      End Get
   End Property

   Private m_dROT As Double
   Public ReadOnly Property dROT As Double
      Get
         Return m_dROT
      End Get
   End Property
   Public Sub SetROT(value As Double)
      m_dROT = value
   End Sub

   Private m_nFALL As Integer
   Public ReadOnly Property nFALL As Integer
      Get
         Return m_nFALL
      End Get
   End Property

   Private m_nTIME As Integer
   Public ReadOnly Property nTIME As Integer
      Get
         Return m_nTIME
      End Get
   End Property

   Public Shared Function CreateTaskResult(CUTID As Integer, TASKID As Integer, ERR As Integer, MSG As String, ROT As Double) As ProcessResult
      If CUTID <> 0 Then
         If TASKID = 0 Then
            Return New ProcessResult(ProcessResultTypes.PART, CUTID, TASKID, ERR, MSG, ROT, 0, 0)
         End If
         Return New ProcessResult(ProcessResultTypes.TASKID, CUTID, TASKID, ERR, MSG, ROT, 0, 0)
      End If
      Return New ProcessResult(ProcessResultTypes.BAR, CUTID, TASKID, ERR, MSG, ROT, 0, 0)
   End Function
   Public Shared Function CreateFallResult(CUTID As Integer, ERR As Integer, MSG As String, FALL As Integer) As ProcessResult
      Return New ProcessResult(ProcessResultTypes.FALL, CUTID, 0, ERR, MSG, 0, FALL, 0)
   End Function
   Public Shared Function CreateTimeResult(CUTID As Integer, TIME As Integer) As ProcessResult
      Return New ProcessResult(ProcessResultTypes.TIME, CUTID, 0, 0, "", 0, 0, TIME)
   End Function

   Protected Sub New(Type As ProcessResultTypes, CUTID As Integer, TASKID As Integer, ERR As Integer, MSG As String, ROT As Double, FALL As Integer, TIME As Integer)
      m_Type = Type
      m_nCUTID = CUTID
      m_nTASKID = TASKID
      m_nERR = ERR
      m_sMSG = MSG
      m_dROT = ROT
      m_nFALL = FALL
      m_nTIME = TIME
   End Sub

End Class