path: root/Game/Code/Classes/UWebCam.pas

unit UWebCam;

interface

uses
     math,
     gl,
     glu,
     glext,
     SysUtils,
     UIni,
     UTime,
     SDL,
     UCaptureWDM;

function wStartWebCam: boolean;
procedure wStopWebCam;

procedure wInit;
procedure wClose;
procedure wDraw(DoDraw: boolean);


var
  WebCamReady:        boolean;
  FGrabFrameFlag :    boolean;

  FTex:               glUint;
  FTexX, FTexY:       integer;
  FdataX, FdataY:     integer;
  FrameDataPtr:       PByteArray;

  frame:              Pointer;

  WDMSample:          TSampleClass;

implementation

uses
  UGraphic,
  ULog,
  UDisplay;

function wStartWebCam(): boolean;
begin
  if not WebCamReady then
    wInit();

  Result := WebCamReady;
  if WebCamReady and not FGrabFrameFlag then
  begin
    glBindTexture(GL_TEXTURE_2D, FTex);

    glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, FTexX, FTexY,
      GL_BGR, GL_UNSIGNED_BYTE, @FrameDataPtr[0]);
    glBindTexture(GL_TEXTURE_2D, 0);
      
    FGrabFrameFlag := true;

    WDMSample.Start;
  end;
end;

procedure wStopWebCam();
begin
  if WebCamReady and FGrabFrameFlag then
  begin
    FGrabFrameFlag := false;
    WDMSample.Stop;
  end;
end;

procedure wInit;
const
  width = 320;
  height = 240;

begin
  if WebCamReady then
    exit;

  WebCamReady := false;

  if(Ini.EnableWebCam=0) then
    exit;

  if (Length(GetCapDevices())-1 < Ini.WebCamID) then
    Exit;

  try
    WDMSample := TSampleClass.Create(Ini.WebCamID, Ini.WebCamMediaID);
  except
    wClose;
    Log.LogError('Error init WDM (UWebCam.wInitWDM)');
    Exit;
  end;

  FTexX := width;
  FTexY := height;
  FdataX := Round(Power(2, Ceil(Log2(FTexX))));
  FdataY := Round(Power(2, Ceil(Log2(FTexY))));

  FrameDataPtr:=WDMSample.FramePtr;

  glGenTextures(1, @FTex);
  glBindTexture(GL_TEXTURE_2D, FTex);
  glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_PRIORITY, 1.0);

  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);

  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

  glTexImage2D(GL_TEXTURE_2D, 0, 3, FdataX, FdataY, 0,
    GL_BGR, GL_UNSIGNED_BYTE, nil);
  glBindTexture(GL_TEXTURE_2D, 0);

  FGrabFrameFlag := false;
  WebCamReady := true;
end;

procedure UploadNewFrame;
begin
  if (not WDMSample.CapStatus) then
    exit;

  FrameDataPtr := WDMSample.FramePtr;

  if (FTexX<>WDMSample.GetWidth) or (FTexY<>WDMSample.GetHeight) then
  begin
    FTexX := WDMSample.GetWidth;
    FTexY := WDMSample.GetHeight;
    FdataX := Round(Power(2, Ceil(Log2(FTexX))));
    FdataY := Round(Power(2, Ceil(Log2(FTexY))));

    glGenTextures(1, @FTex);
    glBindTexture(GL_TEXTURE_2D, FTex);
    glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_PRIORITY, 1.0);

    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);

    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

    glTexImage2D(GL_TEXTURE_2D, 0, 3, FdataX, FdataY, 0,
      GL_BGR, GL_UNSIGNED_BYTE, nil);
    glBindTexture(GL_TEXTURE_2D, 0);
  end;

  glBindTexture(GL_TEXTURE_2D, FTex);

  glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, FTexX, FTexY,
    GL_BGR, GL_UNSIGNED_BYTE, @FrameDataPtr[0]);
  glBindTexture(GL_TEXTURE_2D, 0);

  WDMSample.TriggerCapture;
end;


procedure wDraw(DoDraw: boolean);
var
  SRect: record
    left, right, upper, lower:  double;
  end;

  ScreenAspect:       double;
  CamAspect:          double;
  ScaledVideoWidth:   double;
  ScaledVideoHeight:  double;

begin
  if not WebCamReady then
    exit;

  if DoDraw then
  begin
    try
      UploadNewFrame;
    except
      wClose;
      Log.LogError('Error Uploading new Frame (UWebCam.wDraw)');
      Exit;
    end;
  end else
    Exit;

  ScreenAspect := (ScreenW/Screens) / ScreenH;
  CamAspect := FTexX/FTexY;
  if (ScreenAspect >= 1) then
  begin
    ScaledVideoWidth  := RenderW;
    ScaledVideoHeight := RenderH * ScreenAspect/CamAspect;
  end else
  begin
    ScaledVideoHeight := RenderH;
    ScaledVideoWidth  := RenderW * CamAspect/ScreenAspect;
  end;

  SRect.left := (RenderW - ScaledVideoWidth) / 2;
  SRect.right := SRect.left + ScaledVideoWidth;
  SRect.lower := (RenderH - ScaledVideoHeight) / 2;
  SRect.upper := SRect.lower + ScaledVideoHeight;

  // have a nice black background to draw on (even if there were errors opening the vid)
  glClearColor(0,0,0,1);
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  
  glEnable(GL_TEXTURE_2D);
  glEnable(GL_BLEND);
  
  glColor4f(1, 1, 1, 1);
  glBindTexture(GL_TEXTURE_2D, FTex);
  glbegin(gl_quads);
    // upper-left coord
    glTexCoord2f(FTexX/FdataX, 0);
    glVertex2f(SRect.left, SRect.upper);
    // lower-left coord
    glTexCoord2f(FTexX/FdataX, FTexY/FdataY);
    glVertex2f(SRect.left, SRect.lower);
    // lower-right coord
    glTexCoord2f(0, FTexY/FdataY);
    glVertex2f(SRect.Right, SRect.lower);
    // upper-right coord
    glTexCoord2f(0, 0);
    glVertex2f(SRect.Right, SRect.upper);
  glEnd;

  glDisable(GL_BLEND);
end;

procedure wClose();
begin
  WebCamReady := false;
  FGrabFrameFlag := false;
  if (WDMSample<>nil) then
  begin
    WDMSample.Terminate;
    WDMSample.WaitFor;
    WDMSample.Free;
    WDMSample := nil;
  end;

  if(frame<>nil) then
    FreeMem(frame);
  frame := nil;

  WebCamReady := false;
  glDeleteTextures(1, @FTex);
end;

end.