library steplib;

uses
  Windows, Messages, Types, madCodeHook, SysUtils, SDL, OpenSave;

// ***************************************************************

procedure SDL_JoystickUpdate; cdecl; external 'SDL.dll';
function SDL_JoystickGetButton(J: Pointer; B: Integer): Integer; cdecl; external 'SDL.dll';
procedure SDL_WM_SetCaption(title: PChar; icon: PChar); cdecl; external 'SDL.dll';

const
  MAPVK_VK_TO_VSC = 0;

// ***************************************************************

var
  SDL_GL_SwapBuffersNext: procedure; cdecl;
  SDL_GetKeyStateNext: function(numkeys: PInteger): PKeyStateArr; cdecl;
  SDL_GetTicksNext: function: Cardinal; cdecl;
  SDL_DelayNext: procedure(MS: Cardinal); cdecl;
  randNext: function: Cardinal; cdecl;

// ***************************************************************

function GetESP: Dword; assembler;
asm
  mov eax, esp
end;

function GetStackBottom: Cardinal; assembler;
asm
  mov eax, fs:4
end;

function GameActive: Boolean; // TODO: find a better indicator
begin
  Result := PCardinal($05821120)^ <> 0;
end;

{ $DEFINE LOG}
{$IFDEF LOG}
var
  LogInitialized: Boolean;
  LogSync: RTL_CRITICAL_SECTION;

procedure Log(S: string);
var
  F: Text;
  ESP: DWORD;
begin
  ESP := GetESP;
  if ESP={ $0017F590}31337 then
    asm int 3 end;
  Assign(F, 'log.txt');
  if LogInitialized then
  begin
    EnterCriticalSection(LogSync);
    Append(F);
  end
  else
  begin
    InitializeCriticalSection(LogSync);
    EnterCriticalSection(LogSync);
    ReWrite(F);
  end;
  LogInitialized := True;
  WriteLn(F, {'[', TimeStr, '] ', }IntToHex(ESP, 8), ' ', S);
  Close(F);
  LeaveCriticalSection(LogSync);
end;
{$ELSE}
procedure Log(S: String); inline; begin end;
{$ENDIF}

// ***************************************************************

const
  // these can be trivially found using a PE editor (or some hex editors)
  DataSegAddr = $0047A000;
  DataSegSize = $08F0BF4C;
  MaxStackSize = $40000;

type
  TSaveState = record
    DataSeg: array[0..DataSegSize-1] of Byte;
    Stack: array[0..MaxStackSize-1] of Byte;
    HaveData: Boolean;
    Frames: Cardinal;
    RandSeed: Cardinal;
  end;
  PSaveState = ^TSaveState;

var
  MainEBP: Cardinal;

// ***************************************************************

const
  NumKeysToSave = 10;
  KeysToSave: array[1..NumKeysToSave] of Word = (SDLK_UP, SDLK_DOWN, SDLK_LEFT, SDLK_RIGHT, SDLK_SPACE, SDLK_a, SDLK_d, SDLK_q, SDLK_r, SDLK_F5);

type
  TReplayFrame = set of 1..NumKeysToSave;
  TReplay = record
    Keys: array[0..60*60*10] of TReplayFrame;
    Length: Cardinal;
  end;
  
var
  InitialState: TSaveState;
  Recording, Playing: Boolean;
  Replay: TReplay;
  Frames: Cardinal = 0;
  TicksOffset: Cardinal;

const
  FIXED_FPS = 60;
  FRAME_DURATION = 1000 div FIXED_FPS;

procedure Save(var State: TSaveState);
begin
  State.HaveData := True;
  Move(Pointer(DataSegAddr)^, State.DataSeg, DataSegSize);
  Move(Pointer(MainEBP    )^, State.Stack  , GetStackBottom - MainEBP);
  State.Frames      := Frames     ;
  State.RandSeed    := RandSeed   ;
  //MessageBeep(MB_ICONINFORMATION);
end;

procedure Restore(var State: TSaveState);
begin
  if State.HaveData then
  begin
    Move(State.DataSeg, Pointer(DataSegAddr)^, DataSegSize);
    Move(State.Stack  , Pointer(MainEBP    )^, GetStackBottom - MainEBP);
  end;
  Frames := State.Frames;
  Playing := State.Frames < Replay.Length;
  RandSeed    := State.RandSeed   ;
end;

procedure Clear(var State: TSaveState);
begin
  State.HaveData := False;
  State.Frames   := 0;
  State.RandSeed := 0;
end;

{procedure DumpState(Name: String = 'save');
var
  F: File;
begin
  try
    Assign(F, Name + '.mem');
    ReWrite(F, 1);
    BlockWrite(F, Pointer(SaveAddr)^, SaveSize);
    Close(F);
  except
    on E: Exception do
      MessageBox(0, PChar(E.Message), nil, 0);
  end;
end;}

{procedure Restore;
var
  F: File;
begin
  Assign(F, 'save.mem');
  Reset(F, 1);
  BlockRead(F, Pointer(SaveAddr)^, SaveSize);
  Close(F);
end;}

function SDL_GetTicksCallback: Cardinal; cdecl;
begin
  if GetESP > $00400000 then
  begin
    Result := SDL_GetTicksNext;
    Exit
  end;

  Result := Frames * FRAME_DURATION + TicksOffset;

  //if Recording or Playing then
  //  Log('SDL_GetTicks -> ' + IntToStr(Result) + ' ' + BoolToStr(Recording) + ' ' + BoolToStr(Playing));
end;

procedure SDL_DelayCallback(MS: Cardinal); cdecl;
begin
  Inc(TicksOffset, MS);
end;

function randCallback: Cardinal; cdecl;
begin
  if Recording or Playing then
  begin
    Random(42);
    Result := RandSeed;
    Log('rand -> ' + IntToHex(Result, 8));
  end
  else
    Result := randNext;
end;

procedure StartSync;
begin
  RandSeed := 0;
end;

procedure StopSync;
begin
end;

procedure StopRecording;
begin
  Log('StopRecording');
  StopSync;
  Recording := False;
end;

procedure StopPlaying;
begin
  Log('StopPlaying');
  StopSync;
  Playing := False;
end;

procedure StartRecording;
begin
  Log('StartRecording');
  if Recording then StopRecording;
  if Playing then StopPlaying;
  StartSync;
  Restore(InitialState);
  Recording := True;
  Replay.Length := 0;
end;

procedure StartPlaying;
begin
  Log('StartPlaying');
  if Recording then StopRecording;
  if Playing then StopPlaying;
  Restore(InitialState);
  Recording := False; Playing := True;
end;

procedure ContinueRecording;
begin
  Log('ContinueRecording');
  Playing := False;
  Recording := True;
end;

// ***************************************************************

function SaveReplay: Boolean;
var
  FileName: String;
  F: File;
  Dummy: Cardinal;
begin
  Result := False;
  if OpenSaveFileDialog(0, 'hmd', 'HMD replays|*.hmd', '', 'Save to?', FileName, False) then
  begin
    Assign(F, FileName);
    ReWrite(F, 1);
    Dummy := 0;
    BlockWrite(F, Dummy, 4);
    BlockWrite(F, Replay.Keys, Replay.Length*SizeOf(TReplayFrame));
    Close(F);
    Result := True;
  end;
end;

procedure LoadReplayFrom(FileName: String);
var
  F: File;
  Dummy: Cardinal;
begin
  Assign(F, FileName);
  Reset(F, 1);
  //Clear(Replay.InitialState);
  Replay.Length := (FileSize(F)-4) div SizeOf(TReplayFrame);
  BlockRead(F, Dummy, 4);
  BlockRead(F, Replay.Keys, Replay.Length*SizeOf(TReplayFrame));
  Close(F);

  StartPlaying;
end;

function LoadReplay: Boolean;
var
  FileName: String;
begin
  Result := False;
  if OpenSaveFileDialog(0, 'hmd', 'HMD replays|*.hmd', '', 'Load from?', FileName, True) then
  begin
    LoadReplayFrom(FileName);
    Result := True;
  end;
end;

// ***************************************************************

const
  Caption = 'Quarter20';

function IsKeyPressed(Key: Cardinal): Boolean;
var
  PID: Cardinal;
  WClass, WText: array[0..15] of Char;
  h: HWND;
begin
  h := GetForegroundWindow;
  GetClassName(h, WClass, 15);
  GetWindowText(h, WText, 15);
  GetWindowThreadProcessId(h, PID);
  Result := (GetAsyncKeyState(Key)<0) and 
        (
         ((PID=GetCurrentProcessId) and (PChar(@WClass)='SDL_app')) 
         or 
         ((Copy(PChar(@WText), 1, Length(Caption))=Caption) and (PChar(@WClass)<>'SDL_app'))
        );
end;

var
  SleepTime: Integer;
  LastESP: Dword;
  FPS: Cardinal;
  Paused: Boolean;
  LastSecond: Cardinal;
  SaveStates: array[1..10] of PSaveState;
  Status: String;
  StatusTime: Cardinal;

procedure UpdateCaption(NewStatus: String = '');
var
  S: String;
begin
  S := 'Quarter20 - ';
  if Playing then
    S := S + 'Playing: frame ' + IntToStr(Frames) + ' / ' + IntToStr(Replay.Length)
  else
  if Recording then
    S := S + 'Recording: frame ' + IntToStr(Frames)
  else
    S := S + 'Frame ' + IntToStr(Frames);
  S := S + ' | Delay: ' + IntToStr(SleepTime);
  if Paused then
    S := S + ' | Paused';
  if NewStatus<>'' then
  begin
    Status := NewStatus;
    StatusTime := GetTickCount;
  end;
  if Status<>'' then
    if GetTickCount - StatusTime > 1000 then
      Status := '';
  if Status<>'' then
    S := S + ' | ' + Status;
  //S := S + ' | ' + IntToStr(PCardinal(HMDEnabled)^);
  SDL_WM_SetCaption(PChar(S), nil);
end;

{$I MsgNames.inc}

procedure LogMsg(var Msg: MSG);
var
  I: Integer;
begin
  for I:=1 to High(MsgNames) do
    if MsgNames[I].Value=Msg.Message then
    begin
      Log(TimeToStr(Now) + '  ' + MsgNames[I].Name + '     ' + IntToHex(Msg.WParam,8)+' '+IntToHex(Msg.LParam,8));
      Exit
    end;
  Log(TimeToStr(Now) + '  '+ inttohex(Msg.Message, 8)+'     '+IntToHex(Msg.WParam,8)+' '+IntToHex(Msg.LParam,8));
end;

procedure Wait(Time: Integer = 10);
{var
  m: MSG;}
begin
  {while PeekMessage(m, 0, WM_TIMER, WM_TIMER, PM_REMOVE) or
        PeekMessage(m, 0, $0118   , $0118   , PM_REMOVE) do
  begin
    LogMsg(m);
    TranslateMessage(m);
    DispatchMessage(m);
  end;
  PeekMessage(m, 0, 0, 0, PM_NOREMOVE);}
  Sleep(Time);
end;

function HandleControlKeys: Boolean;
var
  I: Integer;
  Extra: String;
  DoSave: Boolean;
begin
  Result := False;
  Extra := '';

  if IsKeyPressed(VK_F2) then
  begin
    if SaveReplay then
      Extra := 'Replay saved';
  end;

  if IsKeyPressed(VK_F3) then
  begin
    if LoadReplay then
      Extra := 'Replay loaded';
  end;

  {if IsKeyPressed(VK_F4) then
  begin
    DumpState;
    Extra := 'State dumped';
    while IsKeyPressed(VK_F4) do
      Wait;
  end;}

  if IsKeyPressed(VK_F6) then
  begin
    if (Replay.Length=0) or (MessageBox(0, 'Start recording a NEW replay, overwriting the existing one?', 'Quarter20', MB_YESNO or MB_ICONWARNING)=IDYES) then
    begin
      StartRecording;
      Extra := 'Recording started';
    end;
    while IsKeyPressed(VK_F6) do
      Wait;
  end;

  if IsKeyPressed(VK_F7) then
  begin
    if not Playing then
      MessageBeep(MB_ICONERROR)
    else
      ContinueRecording;
    Extra := 'Redubbing started';
    while IsKeyPressed(VK_F7) do
      Wait;
  end;

  if IsKeyPressed(VK_F9) then
  begin
    if Replay.Length=0 then
      MessageBeep(MB_ICONERROR)
    else
      StartPlaying;
    Extra := 'Playback started';
    while IsKeyPressed(VK_F9) do
      Wait;
  end;

  if IsKeyPressed(VK_RETURN) then
  begin
    LoadReplayFrom('my.hmd');
    Paused := False;
  end;

  if IsKeyPressed(VK_F12) then
  begin
    if Playing then
    begin
      StopPlaying;
      Extra := 'Playback stopped';
    end
    else
    if Recording then
    begin
      StopRecording;
      Extra := 'Recording stopped';
    end
    else
      MessageBeep(MB_ICONERROR);

    while IsKeyPressed(VK_F12) do
      Wait;
  end;

  for I:=1 to 10 do
    if IsKeyPressed(Ord('0')+I) then
    begin
      DoSave := IsKeyPressed(VK_MENU);
      if DoSave then
      begin
        if SaveStates[I]=nil then
          New(SaveStates[I]);
        Save(SaveStates[I]^);
        Extra := 'Save ' + IntToStr(I) + ' saved';
      end
      else
        if SaveStates[I]=nil then
          MessageBeep(MB_ICONERROR)
        else
        begin
          Restore(SaveStates[I]^);
          Extra := 'Save ' + IntToStr(I) + ' loaded';
        end;
      while IsKeyPressed(Ord('0')+I) do
        Wait;
    end;

  if IsKeyPressed(VK_HOME) then
    SleepTime := 42;
  if IsKeyPressed(VK_END) then
    SleepTime := 17;
  if IsKeyPressed(VK_INSERT) then
    SleepTime := 8;
  if IsKeyPressed(VK_DELETE) then
    SleepTime := 0;
  if IsKeyPressed(VK_F1) then
  begin
    while IsKeyPressed(VK_F1) do
      Wait;
    Paused := not Paused;
  end;

  if IsKeyPressed(VK_NEXT) then
  begin
    Wait(25);
    Result := True;
  end;

  UpdateCaption(Extra);
end;

procedure SDL_GL_SwapBuffersCallback; cdecl;
var
  ESP: DWORD;
  Second: Cardinal;
begin
  asm mov MainEBP, ebp end;

  if Recording or Playing then
    Log('SDL_GL_SwapBuffersCallback @ ' + IntToStr(Frames));

  ESP := GetESP;
  //if ESP<>LastESP then
  //  MessageBeep(0);
  LastESP := ESP;
  
  if GameActive then
  begin
    if (Frames=0) and not InitialState.HaveData then
    begin
      Save(InitialState);
      //LoadReplayFrom('my.hmd');
    end;
    
    Inc(Frames);
    Inc(FPS);
    if TicksOffset > FRAME_DURATION then
      MessageBeep(MB_ICONERROR);
    TicksOffset := 0;
    Second := GetTickCount div 1000;
    if Second<>LastSecond then
    begin
      {if GetAsyncKeyState(VK_MENU)<0 then
        MessageBox(0, PChar(IntToStr(FPS)), nil, 0);}
      FPS := 0;
      LastSecond := Second;
    end;

    if Recording or Playing then
    begin
      {if ReplayPos=1 then
        DumpState;{}
      //Inc(ReplayPos);
    end;
    if Recording and (Frames > Replay.Length) then
      Replay.Length := Frames;
    
    HandleControlKeys;

    Sleep(SleepTime);

    if Paused then
    begin
      while IsKeyPressed(VK_SHIFT) do
        Wait;
      repeat
        Wait;
        if HandleControlKeys then
          Break;
      until IsKeyPressed(VK_SHIFT) or not Paused;
    end;
  end
  else
  begin
    Frames := 0;
    SDL_WM_SetCaption('Quarter20 - No game running', nil);
  end;

  SDL_GL_SwapBuffersNext;
end;

// ***************************************************************

function SDL_GetKeyStateCallback(numkeys: PInteger): PKeyStateArr; cdecl;
var
  I: Integer;
begin
  if Recording or Playing then
    Log('SDL_GetKeyStateCallback @ ' + IntToStr(Frames));

  Result := SDL_GetKeyStateNext(numkeys);

  if Recording then
    if Frames > High(Replay.Keys) then
      StopRecording
    else
    begin
      {if ReplayPos=0 then
        Result[SDLK_F5] := 1;
      if ReplayPos=1 then
        Result[SDLK_F5] := 0;}
      Replay.Keys[Frames] := [];
      for I:=1 to NumKeysToSave do
        if Result[KeysToSave[I]]<>0 then
          Replay.Keys[Frames] := Replay.Keys[Frames] + [I];
      //Inc(ReplayPos);
    end;
  
  if Playing then
    if Frames >= Replay.Length then
    begin
      StopPlaying;
      Paused := True;
    end
    else
    begin
      for I:=1 to NumKeysToSave do
        Result[KeysToSave[I]] := Ord(I in Replay.Keys[Frames]);
      //Inc(ReplayPos);
    end;
end;

// ***************************************************************

procedure Patch(Addr: Cardinal; Value: Byte);
var
  OldProtect: Cardinal;
begin
  VirtualProtect(Pointer(Addr), 1, PAGE_EXECUTE_READWRITE, OldProtect);
  PByte(Addr)^ := Value;
end;

{var
  F: Text;}

begin
  // Disable intro, enable "Inglorious basterd" button
  Patch($0044988B, $E9);
  Patch($0044988C, $EB);
  Patch($0044988D, $01);
  Patch($0044988E, $00);
  Patch($00449890, $90);
  Patch($00449C12, $90);
  Patch($00449C13, $90);
  
  HookAPI('sdl.dll', 'SDL_GL_SwapBuffers', @SDL_GL_SwapBuffersCallback, @SDL_GL_SwapBuffersNext);
  HookAPI('sdl.dll', 'SDL_GetKeyState', @SDL_GetKeyStateCallback, @SDL_GetKeyStateNext);
  HookAPI('sdl.dll', 'SDL_GetTicks', @SDL_GetTicksCallback, @SDL_GetTicksNext);
  HookAPI('sdl.dll', 'SDL_Delay', @SDL_DelayCallback, @SDL_DelayNext);
  HookAPI('MSVCRT.dll', 'rand', @randCallback, @randNext);

  {Assign(F, 'speed.txt');
  Reset(F);
  ReadLn(F, Speed);
  Close(F);}
end.