egtbeamwall/EgtBEAMWALL.ViewerOptimizer/Integration/CalcIntegration.vb

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

Public Class CalcIntegration

   Private _thread As System.Threading.Thread

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

   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 nBarType As ProjectType
   End Class

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

   Public Sub New()
   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 Shared 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.nBarType = ProjectType.PROJ Then
            Bar.sBarPath = CreateNewProjectFromPart(Bar.nBarId, sProjDirPath)
         ElseIf Bar.nBarType = ProjectType.PROD Then
            Bar.sBarPath = CreateNewProjectFromMachGroup(Bar.nBarId, sProjDirPath)
         End If
      Next

      callback(0.1, "", bCancel)

      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, Map.refMainWindowVM.MainWindowM.GetMaxInstances())

      ' 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

      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 & """ " &
                                                         """" & Map.refMachinePanelVM.SelectedMachine.nType & """ " &
                                                         """" & Map.refMachinePanelVM.SelectedMachine.Name & """ " & 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 ProcessResults(vBar(nCurrBar))
                     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 ProcessResults(vBar(vProc(j).nBar))
                     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 ProcessResults(vBar(vProc(j).nBar))
                     bDone = True
                     vProc(j).nBar = -1
                     nActProc -= 1
                  End If
               Else
                  vProc(j).Proc.Refresh()
               End If
            End If

            If bDone Then
               ' 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)

               If bCancel Then
                  ' fine
                  callback(1, "", bCancel)
                  Return
               End If
               nPgsCurrBar = 0
               nPgsClock = 0
            Else
               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
            nPgsClock += 1
            Thread.Sleep(1)
         Next

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

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

         If bAllKO Then
            MessageBox.Show("Execution error (all processes are disabled)")
            Exit While
         End If

         Thread.Sleep(10)
      End While

      Thread.Sleep(300)

      ' fine
      callback(1, "Done", bCancel)
      Map.refMyStatusBarVM.ResetStopProgress()
   End Sub

   Private Shared 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.BIN)

      ' Ripristino visibilita' pezzo
      EgtSetMode(nPartId, nOldPartMode)

      ' Ripristino stato segnalazione modifica
      DisableMgr.ReEnable()

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

   Private Shared 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 sMachGroupFilePath As String = sProjDirPath & "\" & nMachGroupId.ToString() & ".bwe"
      If EgtSaveObjToFile(nMachGroupId, sMachGroupFilePath, NGE.BIN) Then
         Return sMachGroupFilePath
      End If
      Return String.Empty
   End Function

   Private Shared Function UpdateCutIdAndTaskId(nPartId As Integer) As Boolean
      ' Assegno Id a CutId per calcoli
      EgtSetInfo(nPartId, "CUTID", nPartId, True)
      ' 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
            ' assegno TASKID alla feature per calcoli
            EgtSetInfo(nFeatureId, "TASKID", nFeatureId, True)
         End If
         nFeatureId = EgtGetNext(nFeatureId)
      End While
      Return True
   End Function

   Private Shared Sub ProcessResults(Bar As Bar)

      Dim BtlPath As String = Bar.sBarPath
      Dim ResPath As String = Path.ChangeExtension(BtlPath, ".txt")
      Dim bErrors As Boolean = False
      Dim nLastErr As Integer = 0
      Dim sLastMsg As String = ""
      Dim nCurrCutId As Integer = 0
      Dim nTotTime As Integer = 0

      If File.Exists(ResPath) Then

         Dim nErr As Integer = 0
         Dim sMsg As String = ""
         Dim dRot As Double = 0
         Dim nFall As Integer = 0
         Dim dPartRot As Double = 0
         Dim dTotRot As Double = 0
         Dim cutId As Integer = 0
         Dim taskId As Integer = 0
         Dim prevCutId As Integer = GDB_ID.NULL
         Dim currBTLPart As BTLPartVM = Nothing
         Dim currPart As PartVM

         Dim lines As String() = System.IO.File.ReadAllLines(ResPath)
         For Each line As String In lines

            If line.StartsWith("ERR=") Then
               Dim nVal As Integer? = GetVal(line, "ERR")
               nErr = (If(nVal IsNot Nothing, nVal.Value, 0))
               sMsg = ""
               dRot = 0
               cutId = 0
               taskId = 0
            ElseIf line.StartsWith("ROT=") Then
               Dim nVal As Integer? = GetVal(line, "ROT")
               Dim nRot As Integer = (If(nVal IsNot Nothing, nVal.Value, 0))
               dRot = Math.Abs(((4 - nRot) Mod 4) * 90)
               dPartRot = Math.Max(dPartRot, dRot)
               dTotRot = Math.Max(dTotRot, dRot)
            ElseIf line.StartsWith("CUTID=") Then
               Dim nVal As Integer? = GetVal(line, "CUTID")
               cutId = (If(nVal IsNot Nothing, nVal.Value, 0))
               If cutId <> prevCutId Then
                  ' aggiornamento globale pezzo precedente
                  If prevCutId <> GDB_ID.NULL Then
                     EgtSetInfo(prevCutId, If(Bar.nBarType = ProjectType.PROJ, ITG_PROJ_ROT, ITG_PROD_ROT), dTotRot, True)
                     dTotRot = 0
                  End If
                  ' aggiornamento risultati in struttura BTL
                  If Bar.nBarType = ProjectType.PROJ Then
                     ' cerco pezzo in btl structure da id
                     For Each Part In Map.refProjectVM.BTLStructureVM.BTLPartVMList
                        If Part.nPartId = cutId Then
                           currBTLPart = Part
                        End If
                     Next
                  ElseIf Bar.nBarType = ProjectType.PROD Then
                     For Each MachGroup As MyMachGroupVM In Map.refMachGroupPanelVM.MachGroupVMList
                        For Each Part In MachGroup.PartVMList
                           If Part.nPartId = cutId Then
                              currPart = Part
                           End If
                        Next
                     Next
                  End If
                  prevCutId = cutId
               End If

            ElseIf line.StartsWith("TASKID=") Then
               Dim nVal As Integer? = GetVal(line, "TASKID")
               taskId = (If(nVal IsNot Nothing, nVal.Value, 0))
               ' se taskid diverso da zero, errore feature
               If taskId <> 0 Then
                  EgtSetInfo(taskId, If(Bar.nBarType = ProjectType.PROJ, ITG_PROJ_ERR, ITG_PROD_ERR), nErr, True)
                  EgtSetInfo(taskId, If(Bar.nBarType = ProjectType.PROJ, ITG_PROJ_MSG, ITG_PROD_MSG), sMsg, True)
                  EgtSetInfo(taskId, If(Bar.nBarType = ProjectType.PROJ, ITG_PROJ_ROT, ITG_PROD_ROT), dRot, True)
                  ' aggiornamento risultati in struttura BTL
                  If Bar.nBarType = ProjectType.PROJ Then
                     ' cerco task in btl structure da id
                     If Not IsNothing(currBTLPart) Then
                        For Each Feature In currBTLPart.BTLFeatureVMList
                           If Feature.nFeatureId = taskId Then
                              DirectCast(Feature, BTLFeatureVM).CalcFeatureUpdate(True, nErr, dRot, nFall, sMsg)
                           End If
                        Next
                     End If
                  ElseIf Bar.nBarType = ProjectType.PROD Then
                     ' cerco task in MachGroupList da id
                     If Not IsNothing(currPart) Then
                        For Each Feature In currPart.FeaturevMList
                           If Feature.nFeatureId = taskId Then
                              DirectCast(Feature, BTLFeatureVM).CalcFeatureUpdate(True, nErr, dRot, nFall, sMsg)
                           End If
                        Next
                     End If
                  End If
                  ' se taskid uguale a zero, errore pezzo
               ElseIf cutId <> 0 Then
                  EgtSetInfo(cutId, If(Bar.nBarType = ProjectType.PROJ, ITG_PROJ_ERR, ITG_PROD_ERR), nErr, True)
                  EgtSetInfo(cutId, If(Bar.nBarType = ProjectType.PROJ, ITG_PROJ_MSG, ITG_PROD_MSG), sMsg, True)
                  ' aggiorno in struttura btl
                  If Bar.nBarType = ProjectType.PROJ Then
                     If Not IsNothing(currBTLPart) Then currBTLPart.CalcPartUpdate(True, nErr, dRot, nFall, sMsg)
                  ElseIf Bar.nBarType = ProjectType.PROD Then
                     If Not IsNothing(currPart) Then currPart.CalcPartUpdate(True, nErr, dRot, nFall, sMsg)
                  End If
               End If
            ElseIf line.StartsWith("FALL=") Then
               Dim nVal As Integer? = GetVal(line, "FALL")
               If Not IsNothing(nVal) Then
                  nFall = nVal
               Else
                  nFall = 0
               End If
            ElseIf line.StartsWith("TIME=") Then
               Dim nVal As Integer? = GetVal(line, "TIME")
               nTotTime = (If(nVal IsNot Nothing, nVal.Value, 0))
               If Bar.nBarType = ProjectType.PROJ AndAlso Not IsNothing(currBTLPart) Then
                  EgtSetInfo(currBTLPart.nPartId, If(Bar.nBarType = ProjectType.PROJ, ITG_PROJ_TIME, ITG_PROD_TIME), nTotTime, True)
               End If

            ElseIf Not String.IsNullOrWhiteSpace(line) AndAlso line <> "---" Then
               sMsg = line
            End If
         Next

      Else
         bErrors = True
         nLastErr = 25
         sLastMsg = "Execution Error"
      End If

      ' aggiornamento risultati in struttura BTL
      If Bar.nBarType = ProjectType.PROJ Then
         ' cerco pezzo in btl structure da id
         For Each Part In Map.refProjectVM.BTLStructureVM.BTLPartVMList
            If Part.nPartId = Bar.nBarId Then
               ' leggo errori da geometria e li aggiorno in struttura btl
               DirectCast(Part, BTLPartVM).CalcFeatureUpdate()
               ' aggiungo nota che indica macchina

            End If
         Next
      ElseIf Bar.nBarType = ProjectType.PROD Then
         ' cerco pezzo in MachGroupList da id
         For Each MachGroup As MyMachGroupVM In Map.refMachGroupPanelVM.MachGroupVMList
            If MachGroup.Id = Bar.nBarId Then
               For Each Part In MachGroup.PartVMList
                  ' leggo errori da geometria e li aggiorno in struttura btl
                  Part.CalcFeatureUpdate()
               Next
               MachGroup.CalcMachGroupUpdate()
            End If
         Next
      End If

   End Sub

   Private Shared Function GetVal(sText As String, sKey As String) As Integer?
      Dim sParts As String() = sText.Split("="c)
      If String.Compare(sParts(0), sKey) <> 0 Then Return Nothing
      Dim nVal As Integer = Nothing

      If Not Integer.TryParse(sParts(1), nVal) Then
         Return Nothing
      Else
         Return nVal
      End If
   End Function

End Class