Imports System

Imports Emgu.CV.UI
Imports Emgu.CV
Imports Emgu.CV.Structure
Imports Emgu.CV.CvEnum

Imports System.IO
Imports System.Xml
Imports System.Windows.Forms
Imports System.Math
Imports System.Drawing

Imports System.Drawing.Imaging
Imports System.Threading


Public Module modFaceRecognition
    Dim tfrFacesRecognized(10) As typeFaceClassifier
    Dim resultImages As New List(Of Image(Of Gray, Byte))()
    Private intNumFacesToAquire As Integer = 10
    'Saving Jpg
    Private boolRECORD As Boolean = False
    Private intResultsListPos As Integer = 0
    Private ImagestoWrite As New List(Of Image(Of Gray, Byte))()
    Private ENC_Parameters As New EncoderParameters(1)
    Private ENC As New EncoderParameter(System.Drawing.Imaging.Encoder.Quality, 100)
    Private Image_Encoder_JPG As ImageCodecInfo

    'Saving XAML Data file
    Private xmlDocumnt As New XmlDocument()
    Private termCrit As MCvTermCriteria
    Private eigenFaceRecognizer As EigenObjectRecognizer

    Private ingTrainingList As New List(Of Image(Of Gray, Byte))()
    Private strNamesList As New List(Of String)()
    Private intContTrain As Integer, intNumLabels As Integer

    Private Face As New HaarCascade("haarcascade_frontalface_alt2.xml")
    Private emcuFont As New Emgu.CV.Structure.MCvFont(CvEnum.FONT.CV_FONT_HERSHEY_COMPLEX, 0.5, 0.5)

    Public Function ftnFaceRecognitionLoad() As Boolean
        Try
            termCrit = New MCvTermCriteria(intContTrain, 0.001)
            boolTrained = ftnLoadTrainingData()
            ftnFaceRecognitionLoad = boolTrained
        Catch ex As Exception
            frmDebug.subWriteLogs(" EXCEPTION in ftnFaceRecognitionLoad :  " & ex.ToString)
        End Try
    End Function

    Public Function ftnClassifierRecognize(Input_image As Image(Of Gray, Byte)) As String
        Try
            If boolTrained Then
                ftnClassifierRecognize = eigenFaceRecognizer.Recognize(Input_image)
            Else
                ftnClassifierRecognize = ""
            End If
        Catch ex As Exception
            ftnClassifierRecognize = ""
            frmDebug.subWriteLogs(" EXCEPTION in ftnClassifierRecognize :  " & ex.ToString)
        End Try
    End Function

    Public Sub subFaceClassifierDispose()
        eigenFaceRecognizer = Nothing
        ingTrainingList = Nothing
        strNamesList = Nothing
        GC.Collect()
    End Sub

    Function ftnLoadTrainingData() As Boolean
        Try
            ftnLoadTrainingData = False
            Dim strPersonName As String = ""
            strNamesList.Clear()
            ingTrainingList.Clear()

            If File.Exists(Application.StartupPath & "/TrainedFaces/TrainedLabels.xml") Then _
                My.Computer.FileSystem.DeleteFile(Application.StartupPath & "/TrainedFaces/TrainedLabels.xml") ',
            If Not Directory.Exists(Application.StartupPath + "/TrainedFaces/") Then _
                Directory.CreateDirectory(Application.StartupPath + "/TrainedFaces/")
            Dim strFileName As String = Dir(Application.StartupPath + "\TrainedFaces\" & "*.jpg")
            Do While Len(strFileName) > 0
                ingTrainingList.Add(New Image(Of Gray, Byte)(Application.StartupPath + "\TrainedFaces\" + strFileName))

                strPersonName = Replace(strFileName, ".jpg", "")
                strPersonName = Mid(strPersonName, InStr(strPersonName, "_") + 1)
                strPersonName = Left(strPersonName, Max(InStr(strPersonName, "_") - 1, 0))
                strNamesList.Add(strPersonName)
                ftnSaveTrainingXml(strFileName, strPersonName)

                intNumLabels += 1
                strFileName = Dir()
            Loop
            intContTrain = intNumLabels
            ftnLoadTrainingData = (intNumLabels >= 10)
            If ingTrainingList.ToArray().Length <> 0 Then
                eigenFaceRecognizer = New EigenObjectRecognizer(ingTrainingList.ToArray(), strNamesList.ToArray(), 5000, termCrit)      '5000 default
                Return True
            Else
                Return False
            End If
        Catch ex As Exception
            frmDebug.subWriteLogs(" EXCEPTION in ftnLoadTrainingData :  " & ex.ToString)
            ftnLoadTrainingData = False
        End Try
    End Function

    Private imageResult As Image(Of Gray, Byte)
    Dim boolFaceRecognitionBusy As Boolean = False
    Public Sub subFaceRecognition(ByRef currentFrame As Image(Of Bgr, [Byte]))
        Try
            'If Not frmVideo.Visible Then frmVideo.subVideoStart()
            If Not boolFaceRecognitionBusy Then
                boolFaceRecognitionBusy = True
                currentFrame = currentFrame.Resize(480 * currentFrame.Width / currentFrame.Height, 480, INTER.CV_INTER_NN)
                Dim faces As MCvAvgComp()() = ftnFindFaces(currentFrame.Convert(Of Gray, [Byte])())
                If faces IsNot Nothing Then
                    Dim intName As Short = 0
                    Dim tfrFacesRecognizedTemp(10) As typeFaceClassifier
                    For Each FaceDetected In faces(0) ' As MCvAvgComp
                        imageResult = currentFrame.Copy(FaceDetected.rect).Convert(Of Gray, Byte)().Resize(100, 100, Emgu.CV.CvEnum.INTER.CV_INTER_CUBIC)
                        imageResult._EqualizeHist()
                        currentFrame.Draw(FaceDetected.rect, New Bgr(Color.Red), 2)        'draw the face detected in the 0th (gray) channel
                        If boolRECORD Then subRecordFaces(faces) ' save the faces
                        tfrFacesRecognizedTemp(intName).X = (FaceDetected.rect.X + FaceDetected.rect.Width / 2)
                        tfrFacesRecognizedTemp(intName).Y = FaceDetected.rect.Y + FaceDetected.rect.Height / 2
                        tfrFacesRecognizedTemp(intName).intSize = FaceDetected.rect.Height + FaceDetected.rect.Width
                        If boolTrained Then         'draw the face detected and name
                            tfrFacesRecognizedTemp(intName).strFaceName = modFaceRecognition.ftnClassifierRecognize(imageResult)
                            currentFrame.Draw(tfrFacesRecognizedTemp(intName).strFaceName, emcuFont, New Point(FaceDetected.rect.X - 2, FaceDetected.rect.Y - 2), New Bgr(Color.LightGreen))
                        Else
                            tfrFacesRecognizedTemp(intName).strFaceName = "unknown"
                        End If
                        intName += 1
                        intName = Min(intName, 9)
                    Next FaceDetected
                    tfrFacesRecognized = tfrFacesRecognizedTemp
                Else
                    tfrFacesRecognized.Initialize()
                End If
                boolFaceRecognitionBusy = False
            End If
        Catch ex As Exception
            boolFaceRecognitionBusy = False
            frmDebug.subWriteLogs(" EXCEPTION in subFaceRecognition :  " & ex.ToString)
        End Try
    End Sub

    Function ftnFindFaces(ByRef grayframe As Image(Of Gray, [Byte])) As MCvAvgComp()()
        ftnFindFaces = grayframe.DetectHaarCascade(Face, 1.3, 4, Emgu.CV.CvEnum.HAAR_DETECTION_TYPE.DO_CANNY_PRUNING, New Size(20, 20))
        'Dim Face As new HaarCascade("haarcascade_frontalface_alt2.xml")()
        'ftnFindFaces = Face.Detect(grayframe, 1.3, 4, Emgu.CV.CvEnum.HAAR_DETECTION_TYPE.DO_CANNY_PRUNING, New Size(20, 20))
        'ftnFindFaces = Face.Detect(grayframe)

        '  see http://fewtutorials.bravesites.com/entries/emgu-cv-c/level-3c---how-to-improve-face-detection'
    End Function

    Sub subRecordFaces(ByRef faces As MCvAvgComp()())
        Try
            If boolRECORD And (faces.Length > 0) And (resultImages.Count < intNumFacesToAquire) Then
                resultImages.Add(imageResult)
                ftnSendCommand("play phrase click")
                subWait(500)
                If (resultImages.Count = intNumFacesToAquire) Then ' Save faces
                    For i As Integer = 0 To resultImages.Count - 1
                        ftnSaveTrainingData(resultImages(i).ToBitmap())
                    Next
                    ftnSendCommand("play phrase tada")
                    boolRECORD = False
                End If
            End If
        Catch ex As Exception
            frmDebug.subWriteLogs(" EXCEPTION in subRecordFaces :  " & ex.ToString)
        End Try
    End Sub

    Public Sub subWhoAmI()
        Try
            If boolEnableFaceRecognition Then
                If (tfrFacesRecognized(0).strFaceName = "") Then
                    subSpeak(" I see no one")
                Else
                    Dim intFace As Short = 0
                    While (tfrFacesRecognized(intFace).strFaceName <> "")
                        subSpeak(" I see " & tfrFacesRecognized(intFace).strFaceName)
                        intFace += 1
                    End While
                End If
            End If
        Catch ex As Exception
            frmDebug.subWriteLogs(" EXCEPTION in subWhoAmI :  " & ex.ToString)
        End Try
    End Sub

    Public Function ftnSaveTrainingData(face_data As Image) As Boolean    'Saving The Data
        Try
            If (strPersonName <> "") Then
                Dim randFileNumber As New Random()
                Dim boolFileCreate As Boolean = True
                Dim strFileName As String = "face_" + strPersonName + "_" + randFileNumber.[Next]().ToString() + ".jpg"
                If Not Directory.Exists(Application.StartupPath + "/TrainedFaces/") Then _
                    Directory.CreateDirectory(Application.StartupPath + "/TrainedFaces/")
                While boolFileCreate
                    If Not File.Exists(Application.StartupPath + "/TrainedFaces/strFileName") Then
                        boolFileCreate = False
                    Else
                        strFileName = "face_" + strPersonName + "_" + randFileNumber.[Next]().ToString() + ".jpg"
                    End If
                End While

                If Directory.Exists(Application.StartupPath + "/TrainedFaces/") Then  ' save the face picture
                    face_data.Save(Convert.ToString(Application.StartupPath + "/TrainedFaces/") & strFileName, ImageFormat.Jpeg)
                Else
                    Directory.CreateDirectory(Application.StartupPath + "/TrainedFaces/")
                    face_data.Save(Convert.ToString(Application.StartupPath + "/TrainedFaces/") & strFileName, ImageFormat.Jpeg)
                End If

                ftnSaveTrainingData = ftnSaveTrainingXml(strFileName, strPersonName)
            Else
                subSpeak("tell me the name first")
                Return False
            End If
        Catch ex As Exception
            frmDebug.subWriteLogs(" EXCEPTION in ftnSaveTrainingData :  " & ex.ToString)
            Return False
        End Try
    End Function


    Public Function ftnSaveTrainingXml(ByVal strFileName As String, ByVal strPersonName As String) As Boolean    'Saving The Data
        Try
            If File.Exists(Application.StartupPath & "/TrainedFaces/TrainedLabels.xml") Then
                Dim loading As Boolean = True
                While loading
                    Try
                        xmlDocumnt.Load(Application.StartupPath & "/TrainedFaces/TrainedLabels.xml")
                        loading = False
                    Catch ex As Exception
                        xmlDocumnt = Nothing
                        xmlDocumnt = New XmlDocument()
                        Thread.Sleep(10)
                    End Try
                End While

                Dim root As XmlElement = xmlDocumnt.DocumentElement
                Dim face_D As XmlElement = xmlDocumnt.CreateElement("FACE")
                Dim name_D As XmlElement = xmlDocumnt.CreateElement("NAME")
                Dim file_D As XmlElement = xmlDocumnt.CreateElement("FILE")

                name_D.InnerText = strPersonName
                file_D.InnerText = strFileName
                face_D.AppendChild(name_D)
                face_D.AppendChild(file_D)
                root.AppendChild(face_D)

                xmlDocumnt.Save(Application.StartupPath & "/TrainedFaces/TrainedLabels.xml")
            Else
                Dim FS_Face As FileStream = File.OpenWrite(Application.StartupPath & "/TrainedFaces/TrainedLabels.xml")
                Using writer As XmlWriter = XmlWriter.Create(FS_Face)
                    writer.WriteStartDocument()
                    writer.WriteStartElement("Faces_For_Training")

                    writer.WriteStartElement("FACE")
                    writer.WriteElementString("NAME", strPersonName)
                    writer.WriteElementString("FILE", strFileName)
                    writer.WriteEndElement()

                    writer.WriteEndElement()
                    writer.WriteEndDocument()
                    writer.Close()
                    FS_Face.Close()
                End Using
                'FS_Face.Close()  'NEW 28
            End If
            Return True
        Catch ex As Exception
            frmDebug.subWriteLogs(" EXCEPTION in ftnSaveTrainingXml :  " & ex.ToString)
            Return False
        End Try
    End Function

    Public Sub subTrainWebcam()
        Try
            intNumFacesToAquire = 10
            resultImages.Clear()
            boolRECORD = True
            Dim timeOut As DateTime = Now().AddMilliseconds(30000)
            While (Now() < timeOut) And boolRECORD
                subWait(50)
            End While
        Catch ex As Exception
            frmDebug.subWriteLogs(" EXCEPTION in subTrainWebcam :  " & ex.ToString)
        End Try
    End Sub


    Public Sub subTrainPhoto()
        Try
            Dim Face As New HaarCascade("haarcascade_frontalface_alt2.xml")
            Dim imageResult As Image(Of Gray, Byte)
            Dim imgPhoto As Image(Of Bgr, [Byte])
            frmGotABotTop.OpenFD.Title = "Select a Photo"
            frmGotABotTop.OpenFD.Filter = "(Image Files)|*.jpg;*.png;*.bmp;*.gif;*.ico|Jpg, | *.jpg|Png, | *.png|Bmp, | *.bmp|Gif, | *.gif|Ico | *.ico"
            Dim DidWork As Integer = frmGotABotTop.OpenFD.ShowDialog()
            If DidWork <> DialogResult.Cancel Then
                frmDebug.subWriteLogs("file " & frmGotABotTop.OpenFD.FileName)
                imgPhoto = New Image(Of Bgr, [Byte])(frmGotABotTop.OpenFD.FileName)
                Dim faces As MCvAvgComp()() = modFaceRecognition.ftnFindFaces(imgPhoto.Convert(Of Gray, [Byte])())

                If faces IsNot Nothing Then
                    Dim intName As Short = 0
                    Dim tfrFacesRecognizedTemp(10) As typeFaceClassifier
                    For Each FaceDetected In faces(0) ' As MCvAvgComp
                        imageResult = imgPhoto.Copy(FaceDetected.rect).Convert(Of Gray, Byte)().Resize(100, 100, Emgu.CV.CvEnum.INTER.CV_INTER_CUBIC)
                        imageResult._EqualizeHist()
                        ftnSaveTrainingData(imageResult.ToBitmap())
                    Next FaceDetected
                End If
            End If
        Catch ex As Exception
            frmDebug.subWriteLogs(" EXCEPTION in subTrainPhoto :  " & ex.ToString)
        End Try
    End Sub

    Public Sub subLookAtMe()
        Try
            Dim boolEnableFaceRecognitionTemp As Boolean = boolEnableFaceRecognition
            If Not boolEnableFaceRecognition Or Not boolEnableVideo Then
                boolEnableVideo = True
                frmVideo.subVideoStart()
                subWait(1000)
                boolEnableFaceRecognition = True
                If Not boolTrained Then boolTrained = modFaceRecognition.ftnFaceRecognitionLoad()
                subWait(1500)
            End If
            Dim tfcFirstFace As typeFaceClassifier = tfrFacesRecognized(0)
            boolStop = False
            If tfcFirstFace.strFaceName <> "" Then
                ftnSendCommand("play phrase 'OK")
                Dim sngDegreesToCenterY As Single = -(tfcFirstFace.Y * ticCameraResolution.Y / 480 - ticCameraResolution.Y / 2) * sngCameraFOV / ticCameraResolution.X
                If frmArm.boolEnableArm And (Abs(sngDegreesToCenterY) > 5) Then '
                    frmArm.taaNewArmAngles = frmArm.taaArmAngles
                    frmArm.taaNewArmAngles.sngShoulder = frmArm.ftnJointAngleVerify(frmArm.taaArmAngles.sngShoulder + sngDegreesToCenterY / 2)
                    frmArm.taaNewArmAngles.sngElbow += sngDegreesToCenterY
                    frmArm.boolMoveToNewAnglesAPI = True
                End If
                Dim sngDegreesToCenterX As Single = (ticCameraResolution.X / 2 - tfcFirstFace.X * ticCameraResolution.Y / 480) * sngCameraFOV / ticCameraResolution.X
                If (Abs(sngDegreesToCenterX) > 5) Then ' 
                    Dim tbpTargetPose As typeBotPose = tbpBotPose
                    tbpTargetPose.Orientation = ftnConvertTo360(tbpTargetPose.Orientation + sngDegreesToCenterX)
                    tbpBotPose = ftnBotTurn(tbpBotPose, False, tbpTargetPose)
                End If
            Else
                subSpeak("play phraseA  'I dont see anyone'")
            End If
            boolEnableFaceRecognition = boolEnableFaceRecognitionTemp
        Catch ex As Exception
            frmDebug.subWriteLogs(" EXCEPTION in subLookAtMe :  " & ex.ToString)
        End Try
    End Sub

End Module




