// *****************************************************************
// Delphi-OpenCV Demo
// Copyright (C) 2013 Project Delphi-OpenCV
// ****************************************************************
// Contributor:
// Laentir Valetov
// email:laex@bk.ru
// ****************************************************************
// You may retrieve the latest version of this file at the GitHub,
// located at git://github.com/Laex/Delphi-OpenCV.git
// ****************************************************************
// The contents of this file are used with permission, subject to
// the Mozilla Public License Version 1.1 (the "License"); you may
// not use this file except in compliance with the License. You may
// obtain a copy of the License at
// http://www.mozilla.org/MPL/MPL-1_1Final.html
//
// Software distributed under the License is distributed on an
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
// implied. See the License for the specific language governing
// rights and limitations under the License.
// *******************************************************************
// Original: http://public.cranfield.ac.uk/c5354/teaching/ml/examples/c/haar_cascade/haar_cascade.cc
// *******************************************************************
//
// Example : run haar cascade classifier on image / video / camera
// usage: prog {<image_name> | <video_name>}

program FaceDetect;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.Character,
  System.SysUtils,
  System.Math,
  Core.types_c,
  core_c,
  highgui_c,
  objdetect_c,
  imgproc_c,
  imgproc.types_c,
  cvUtils;

Const
  // ******************************************************************************/
  // setup the cameras properly based on OS platform
  CAMERA_INDEX = CV_CAP_ANY;
  // ******************************************************************************/
  windowName            = 'Haar Cascade Detection';                        // window name
  cascade_name: pCVChar = 'FaceDetectXML\haarcascade_frontalface_alt.xml'; // cascade file

Var
  img             : pIplImage  = nil; // image object
  frame           : pIplImage  = nil;
  capture         : pCvCapture = nil; // capture object
  detected_objects: pCvSeq     = nil; // list of detected items
  key             : Integer;          // user input
  EVENT_LOOP_DELAY: Integer = 40;     // delay for GUI window  40 ms equates to 1000ms/25fps=40ms per frame
  cascade         : pCvHaarClassifierCascade;
  storage         : pCvMemStorage;
  gray            : pIplImage;
  imgcopy         : pIplImage;
  i               : Integer;
  r               : pCvRect;
  isCapture:Boolean = false;

begin
  try
    // if command line arguments are provided try to read image/video_name
    // otherwise default to capture from attached H/W camera
    if ParamCount = 1 then
    begin
      img := cvLoadImage(
        c_str(ParamStr(1)),
        CV_LOAD_IMAGE_UNCHANGED);
      if not Assigned(img) then
      begin
        capture := cvCreateFileCapture(c_str(ParamStr(1)));
        isCapture:=True;
      end;
    end;

    if (not Assigned(img)) and (not Assigned(capture)) then
    begin
      capture := cvCreateCameraCapture(CAMERA_INDEX);
      isCapture:=True;
    end;
    if not Assigned(capture) then
      Halt(1);

    // create window object (use flag:=0 to allow resize, 1 to auto fix size)
    cvNamedWindow(
      windowName,
      0);

    // load the trained haar cascade classifier from file
    // and create storage required for detections
    cascade := cvLoad(
      cascade_name,
      nil,
      nil,
      nil);
    if Assigned(cascade) then
      Writeln(
        'LOADED : ',
        cascade_name)
    else
    begin
      Writeln(
        'ERROR: Could not load classifier cascade : ',
        cascade_name);
      Halt(1);
    end;
    try
      storage := cvCreateMemStorage(0);

      // if capture object in use (i.e. video/camera)
      // get initial image from capture object
      if Assigned(capture) then
      begin
        // cvQueryFrame is just a combination of cvGrabFrame
        // and cvRetrieveFrame in one call.
        img := cvQueryFrame(capture);
        if not Assigned(img) then
        begin
          if ParamCount = 1 then
            Writeln('End of video file reached')
          else
            Writeln('ERROR: cannot get next fram from camera');
          Halt(0);
        end;
      end;

      // create a greyscale image upon which to run the classifier
      gray := cvCreateImage(
        cvSize(img^.width, img^.height),
        img^.depth,
        1);

      // create a copy of the image upon which to do detection and box drawing
      imgcopy := cvCloneImage(img);

      // start main loop
      while True do
      begin
        // if capture object in use (i.e. video/camera)
        // get image from capture object
        if Assigned(capture) then
        begin
          // cvQueryFrame is just a combination of cvGrabFrame
          // and cvRetrieveFrame in one call.
          frame := cvQueryFrame(capture);
          if not Assigned(frame) then
          begin
            if ParamCount = 1 then
              Writeln('End of video file reached')
            else
              Writeln('ERROR: cannot get next fram from camera');
            Halt(0);
          end
        end
        else
        begin
          // if not a capture object set event delay to zero so it waits
          // indefinitely (as single image file, no need to loop)
          EVENT_LOOP_DELAY := 0;
        end;

        // N.B. as haar features are orientation dependent (and
        // the haar function operate directly on the pixel
        // array in memory) we'll just check the image
        // is using Top-Left origin in actual memory
        // and if not flip it (use a copy which is not the
        // capture object buffer)
        if (img^.origin = IPL_ORIGIN_TL) then
        begin
          cvCopy(
            frame,
            imgcopy);
        end
        else
        begin
          cvFlip(
            frame,
            imgcopy);
          imgcopy^.origin := IPL_ORIGIN_TL;
        end;
        gray^.origin := imgcopy^.origin;

        // convert input image to grayscale
        cvCvtColor(
          imgcopy,
          gray,
          CV_BGR2GRAY);

        // histogram equalize it also to maximize the region differences
        cvEqualizeHist(
          gray,
          gray);

        // run the haar cascade detection
        // with parameters scale:=1.2, neighbours := 4 and with Canny pruning
        // turned on with minimum detection scale 30x30 pixels
        detected_objects := cvHaarDetectObjects(
          gray,
          cascade,
          storage,
          1.2,
          4,
          CV_HAAR_DO_CANNY_PRUNING,
          cvSize(30, 30),
          cvSize(0, 0));

        // draw a red rectangle around any detected objects
        i := 0;
        While i < ifthen(Assigned(detected_objects), detected_objects^.total, 0) do
        begin
          r := pCvRect(cvGetSeqElem(detected_objects, i));
          cvRectangle(
            imgcopy,
            cvPoint(r^.x, r^.y),
            cvPoint((r^.x) + (r^.width), (r^.y) + (r^.height)),
            CV_RGB(255, 0, 0),
            2,
            8,
            0);
          Inc(i);
        end;
        // if Assigned(detected_objects) then
        // cvClearSeq(detected_objects);
        // cvClearMemStorage(storage);

        // display image in window
        cvShowImage(
          windowName,
          imgcopy);

        // start event processing loop (very important,in fact essential for GUI)
        // 40 ms roughly equates to 1000ms/25fps := 4ms per frame
        key := cvWaitKey(EVENT_LOOP_DELAY);
        if key = 27 then
        begin
          // if user presses 'ESC' then exit
          Writeln('Keyboard exit requested : exiting now - bye!');
          Break;
        end;
      end;

      // destroy window objects
      // (triggered by event loop *only* window is closed)
      cvDestroyAllWindows();
      cvReleaseImage(gray);
      cvReleaseImage(imgcopy);
    finally
      if Assigned(img) and (not isCapture) then
        cvReleaseImage(img);
      // destroy image objects (if it does not originate from a capture object)
      if Assigned(capture) then
        cvReleaseCapture(capture);
      if Assigned(storage) then
        cvReleaseMemStorage(storage);
    end;

  except
    on E: Exception do
      Writeln(
        E.ClassName,
        ': ',
        E.Message);
  end;

end.