unit dgifrecorder;

interface

uses
  dcolors,
  dvector2i,
  dvector2f,
  drect2i,
  dstrnum,
  deng,
  dgifwriter,
  daero_cursor;

type
TGifRecorder = object
private
  FGifWriter: TGifWriter;
  FGifBuffer: array of Byte;
  FGifFileName: PAnsiChar;
  FGifStartedTime: LongInt;
  FGifLastFrame: LongInt;
  FGifFrameDelta: LongInt;
  FGifFrames: LongInt;
  FFileName: AnsiString;
  FRenderCursor: Boolean;
  FRenderStatus: Boolean;
  FUseLargeBuffer: Boolean;
  FLargeBuffer: PByte;
  FLargeBufferSize: SizeUInt;
  FCurrentOffset: SizeUInt;
  FX, FY, FW, FH: Int32;
  FDithering: Boolean;
public
  procedure Init;
  procedure Done;
  function Supported: Boolean; inline;
  procedure StartRecord;
  procedure StopRecord;
  procedure Process;
      // Should be called in Render after all needed render done

  procedure SetPartialRect(X, Y, W, H: Int32);
  procedure SetFullScreenRect;

  function IsRecording: Boolean; inline;
  property FileName: AnsiString read FFileName write FFileName;
  property RenderCursor: Boolean read FRenderCursor write FRenderCursor;
  property RenderStatus: Boolean read FRenderStatus write FRenderStatus;
  property UseLargeBuffer: Boolean read FUseLargeBuffer write FUseLargeBuffer;
  property Dithering: Boolean read FDithering write FDithering;
end;

implementation

procedure TGifRecorder.Init;
begin
  FGifWriter.f := nil;
  FFileName := 'record.gif';
  FRenderCursor := True;
  FRenderStatus := True;
  FUseLargeBuffer := False;
  FDithering := False;
  SetFullScreenRect;
end;

procedure TGifRecorder.Done;
begin
  StopRecord;
end;

function TGifRecorder.Supported: Boolean;
begin
  Exit(True);
end;

procedure TGifRecorder.StartRecord;
begin
  if FGifWriter.f = nil then begin
    if FX = -1 then begin
      FW := Eng.Width;
      FH := Eng.Height;
    end;
    SetLength(FGifBuffer, Eng.Width * Eng.Height * 4);
    if FUseLargeBuffer then begin
      FLargeBufferSize := 256 * FW * FH * 4;
      FLargeBuffer := GetMem(FLargeBufferSize);
      FCurrentOffset := 0;
    end;
    FGifFrameDelta := 60;
    FGifStartedTime := Eng.Time;
    FGifLastFrame := FGifStartedTime - FGifFrameDelta - 1;
    FGifFrames := 0;
    if GifBegin(@FGifWriter, PAnsiChar(@FFileName[1]), FW, FH, FGifFrameDelta div 10, 8, FDithering) then begin
      Log('RECORDING ' + FFileName + ' ' + IntToStr(FW) + 'x' + IntToStr(FH) + 'x' + IntToStr(1000 div FGifFrameDelta));
    end else begin
      Log('FAILED RECORDING');
      GifEnd(@FGifWriter);
      FGifWriter.f := nil;
    end;
  end;
end;

procedure TGifRecorder.StopRecord;
var
  Off: LongInt;
begin
  if FGifWriter.f <> nil then begin
    if FUseLargeBuffer then begin
      Off := 0;
      while Off < FCurrentOffset do begin
        if not GifWriteFrame(@FGifWriter, @FLargeBuffer[Off], FW, FH, FGifFrameDelta div 10, 8, FDithering) then begin
          Log('FAILED SAVING FRAME TO DISK');
          break;
        end;
        Inc(Off, 4 * FW * FH);
      end;
      FreeMem(FLargeBuffer);
    end;
    if GifEnd(@FGifWriter) then begin
      Log('RECORDED ' {+ FFileName + ' '} + IntToStr(FGifFrames) + ' frames');
    end else
      Log('FAILED RECORDING');
    FGifWriter.f := nil;
  end;
end;

procedure TGifRecorder.Process;
var
  C: TVec2i;
  I, J, X, Y: LongInt;
  P: PUInt32;
  A: UInt32;
  Buf: array of Byte;
begin
  if IsRecording then begin
    if Eng.Time - FGifLastFrame > FGifFrameDelta then begin
      Eng.Draw.ReadScreen(@FGifBuffer[0], Eng.Width, Eng.Height);
      if RenderCursor and Eng.WinApi.Window.GetShowCursor then begin
        C := Eng.WinApi.GetMouse;
        for I := 0 to AERO_ARROW_WIDTH - 1 do begin
          for J := 0 to AERO_ARROW_HEIGHT - 1 do begin
            X := C.X + I;
            Y := C.Y + J;
            if (X < 0) or (X >= Eng.Width) or (Y < 0) or (Y >= Eng.Height) then
              continue;
            P := @FGifBuffer[4 * (X + Y * Eng.Width)];
            A := PUInt32(@AERO_ARROW_DATA[4 * (I + J * AERO_ARROW_WIDTH)])^;
            P^ := ColorBlend(A, P^, GetAlpha(A));
          end;
        end;
      end;
      if FUseLargeBuffer then begin
        if FX = -1 then begin
          Move(FGifBuffer[0], FLargeBuffer[FCurrentOffset], 4 * Eng.Width * Eng.Height);
        end else begin
          for J := FY to FY + FH - 1 do begin
            Move(FGifBuffer[4 * (J * Eng.Width + FX)], FLargeBuffer[FCurrentOffset + 4 * (J - FY) * FW], 4 * FW);
          end;
        end;
        Inc(FCurrentOffset, 4 * FW * FH);
        if FCurrentOffset >= FLargeBufferSize then begin
          Log('NOT ENOUGH MEMORY FOR GIF ALLOCATED, RECORD STOPPED');
          StopRecord;
        end;
        Log('CurrentOffest, LargeBufferSize: ' + IntToStr(FCurrentOffset) + ' ' + IntToStr(FLargeBufferSize));
      end else begin
        // TODO generate region (FX,FY,FW,FH)
        if FX = -1 then begin
          if not GifWriteFrame(@FGifWriter, @FGifBuffer[0], Eng.Width, Eng.Height, FGifFrameDelta div 10, 8, False) then begin
            Log('FAILED RECORDING FRAME');
            StopRecord;
          end;
        end else begin
          SetLength(Buf, FW * FH * 4);
          for J := FY to FY + FH - 1 do begin
            Move(FGifBuffer[4 * (J * Eng.Width + FX)], Buf[4 * (J - FY) * FW], 4 * FW);
          end;
          if not GifWriteFrame(@FGifWriter, @Buf[0], FW, FH, FGifFrameDelta div 10, 8, False) then begin
            Log('FAILED RECORDING FRAME');
            StopRecord;
          end;
        end;
      end;
      Inc(FGifLastFrame, FGifFrameDelta);
      Inc(FGifFrames);
    end;
    if RenderStatus and (((Eng.Time - FGifStartedTime) mod 1000) < 500) then begin
      Eng.Draw.RGBA(255, 0, 0, 255);
      Eng.Draw.CircleFilled(Vec2f(30, 30), 10);
    end;
    if RenderStatus and (FX <> -1) then begin
      Eng.Draw.RGBA(255, 0, 0, 255);
      Eng.Draw.Rect(drect2i.Rect2i(Vec2i(FX, FY), Vec2i(FW, FH)));
    end;
    // for 10s coubs
    //if FGifLastFrame - FGifStartedTime >= 10000 then
    //  StopRecord;
  end;
end;

procedure TGifRecorder.SetPartialRect(X, Y, W, H: Int32);
begin
  FX := X;
  FY := Y;
  FW := W;
  FH := H;
end;

procedure TGifRecorder.SetFullScreenRect;
begin
  FX := -1;
  FY := -1;
  FW := -1;
  FH := -1;
end;

function TGifRecorder.IsRecording: Boolean;
begin
  Exit(FGifWriter.f <> nil);
end;

end.
