unit MainFm;

{$mode objfpc}{$H+}

//---------------------------------------------------------------------------
interface

//---------------------------------------------------------------------------
uses
  Windows, Messages, SysUtils, LResources, Classes, Controls, Forms,
  Dialogs, AsphyreTypes, SystemSurfaces;

//---------------------------------------------------------------------------
type
  TMainForm = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    Surface: TSystemSurface;

    SinTab, CosTab: array[0..1023] of Word;
    PaletteTab: array[0..1023] of Cardinal;
    iShift, jShift: Integer;
    PalIndex: Integer;

    procedure InitPlasma();
    procedure InitPalette();

    function CreateDraftImage(): Integer;
    procedure UploadNative(Bits: Pointer; Pitch: Integer);
    procedure UploadConversion(Bits: Pointer; Pitch: Integer;
     Format: TAsphyrePixelFormat);

    procedure OnDeviceCreate(Sender: TObject; Param: Pointer;
     var Handled: Boolean);

    procedure TimerEvent(Sender: TObject);
    procedure ProcessEvent(Sender: TObject);
    procedure RenderEvent(Sender: TObject);

    procedure DoPlasma();
    procedure WMDisplayChange(var message:TMessage); message WM_DISPLAYCHANGE;
  public
    { Public declarations }
  end;

//---------------------------------------------------------------------------
var
  MainForm: TMainForm;

//---------------------------------------------------------------------------
implementation
uses
 Vectors2, Vectors2px, AsphyreTimer, AsphyreFactory, AsphyreDb, AbstractDevices,
 AbstractCanvas, AsphyreImages, AsphyreFonts, DX7Providers, AsphyrePalettes,
 GameTypes, AsphyreConv, AsphyreColors;

//---------------------------------------------------------------------------
procedure TMainForm.FormCreate(Sender: TObject);
begin
 InitPlasma();
 InitPalette();

 // Set the display size
 DisplaySize:= Point2px(ClientWidth, ClientHeight);

 // Indicate that we're using DirectX 7.0
 Factory.UseProvider(idDirectX7);

 // Create Asphyre components in run-time.
 GameDevice:= Factory.CreateDevice();
 GameCanvas:= Factory.CreateCanvas();
 GameImages:= TAsphyreImages.Create();

 GameFonts:= TAsphyreFonts.Create();
 GameFonts.Images:= GameImages;
 GameFonts.Canvas:= GameCanvas;

 MediaASDb:= TASDb.Create();
 MediaASDb.FileName:= ExtractFilePath(ParamStr(0)) + 'media.asdb';
 MediaASDb.OpenMode:= opReadOnly;

 GameDevice.WindowHandle:= Self.Handle;
 GameDevice.Size    := DisplaySize;
 GameDevice.Windowed:= True;
 GameDevice.VSync   := False;

 EventDeviceCreate.Subscribe(@OnDeviceCreate, 0);

 // Create Plasma surface
 Surface:= TSystemSurface.Create();
 Surface.SetSize(256, 256);

 // Attempt to initialize Asphyre device.
 if (not GameDevice.Initialize()) then
  begin
   ShowMessage('Failed to initialize Asphyre device.');
   Application.Terminate();
   Exit;
  end;

 // Create rendering timer.
 Timer.OnTimer  := @TimerEvent;
 Timer.OnProcess:= @ProcessEvent;
 Timer.Speed    := 60.0;
 Timer.MaxFPS   := 4000;
 Timer.Enabled  := True;
end;

//---------------------------------------------------------------------------
procedure TMainForm.FormDestroy(Sender: TObject);
begin
 Timer.Enabled:= False;

 // Release plasma surface.
 FreeAndNil(Surface);

 // Release all Asphyre components.
 FreeAndNil(GameFonts);
 FreeAndNil(GameImages);
 FreeAndNil(MediaASDb);
 FreeAndNil(GameCanvas);
 FreeAndNil(GameDevice);
end;

//---------------------------------------------------------------------------
procedure TMainForm.InitPlasma();
var
 i: Integer;
begin
 // make lookup tables
 for i:= 0 to 1023 do
  begin
   SinTab[i]:= (Trunc(Sin(2.0 * Pi * i / 1024.0) * 512) + 512) and $3FF;
   CosTab[i]:= (Trunc(Cos(2.0 * Pi * i / 1024.0) * 512) + 512) and $3FF;
  end;

 // sine / cosine displacers
 iShift:= 0;
 jShift:= 0;
end;

//---------------------------------------------------------------------------
procedure TMainForm.InitPalette();
var
 Palette: TAsphyrePalette;
 i: Integer;
begin
 Palette:= TAsphyrePalette.Create();
 Palette.Add($FF000000, ntSine, 0.0);
 Palette.Add($FF7E00FF, ntSine, 0.1);
 Palette.Add($FFE87AFF, ntSine, 0.2);
 Palette.Add($FF7E00FF, ntSine, 0.3);
 Palette.Add($FFFFFFFF, ntSine, 0.4);

 Palette.Add($FF000000, ntPlain, 0.5);
 Palette.Add($FF0500A8, ntBrake, 0.6);
 Palette.Add($FFBEFF39, ntAccel, 0.7);
 Palette.Add($FFFFC939, ntBrake, 0.8);
 Palette.Add($FFFFF58D, ntSine,  0.9);
 Palette.Add($FF000000, ntPlain, 1.0);

 for i:= 0 to 1023 do
  PaletteTab[i]:= Palette.Color[i / 1023.0];

 Palette.Free();
end;

//---------------------------------------------------------------------------
function TMainForm.CreateDraftImage(): Integer;
var
 Image: TAsphyreImage;
begin
 Image:= TAsphyreImage.Create();
 Image.MipMapping  := False;
 Image.PixelFormat := apf_A8R8G8B8;
 Image.DynamicImage:= True;

 if (Image.InsertTexture(256, 256) = nil) then
  begin
   Result:= -1;
   Exit;
  end;

 Result:= GameImages.Include(Image); 
end;

//---------------------------------------------------------------------------
procedure TMainForm.OnDeviceCreate(Sender: TObject; Param: Pointer;
 var Handled: Boolean);
var
 Success: Boolean;
begin
 // This variable returns "Success" to Device initialization, so if you
 // set it to False, device creation will fail.
 Success:= Boolean(Param^);

 GameImages.RemoveAll();      
 GameFonts.RemoveAll();

 // This image is used by our bitmap font.
 GameImages.AddFromASDb('tranceform.image', MediaASDb);

 fontTranceform:= GameFonts.Insert('/media.asdb | tranceform.xml',
  'tranceform.image');

 imagePlasma  := CreateDraftImage();
 imageScanline:= GameImages.AddFromASDb( 'scanline.image', MediaASDb);

 Success:=
  Success and
  (imageScanline <> -1)and
  (fontTranceform <> -1);

 Boolean(Param^):= Success;
end;

//---------------------------------------------------------------------------
procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
 Shift: TShiftState);
begin
 // Handle Alt + Enter to switch between windowed / full-screen
 if (Key = VK_RETURN)and(ssAlt in Shift) then
  begin
   Tag:= 1;
   GameDevice.Windowed:= not GameDevice.Windowed;

   if (GameDevice.Windowed) then
    begin
     BorderStyle:= bsSingle;

     ClientWidth := GameDevice.Size.x;
     ClientHeight:= GameDevice.Size.y;

     BorderIcons:= [biSystemMenu, biMinimize];
    end else
    begin
     BorderStyle:= bsNone;

     Width := GameDevice.Size.x;
     Height:= GameDevice.Size.y;

     BorderIcons:= [];
    end;

   Tag:= 0;
  end;
end;

//---------------------------------------------------------------------------
procedure TMainForm.FormResize(Sender: TObject);
begin
 if (GameDevice.Size.x <> ClientWidth)or(GameDevice.Size.y <> ClientHeight) then
  GameDevice.Size:= Point2px(ClientWidth, ClientHeight);
end;

//---------------------------------------------------------------------------
procedure TMainForm.TimerEvent(Sender: TObject);
begin
 DoPlasma();

 GameDevice.Render(@RenderEvent, $000000);
 Timer.Process();
end;

//---------------------------------------------------------------------------
procedure TMainForm.ProcessEvent(Sender: TObject);
begin
 Inc(iShift);
 Dec(jShift);
 Inc(PalIndex);
end;

//---------------------------------------------------------------------------
procedure TMainForm.RenderEvent(Sender: TObject);
var
 j, i: Integer;
begin
 for j:= 0 to (ClientHeight div 256) do
  for i:= 0 to (ClientWidth div 256) do
   begin
    GameCanvas.UseImage(GameImages[imagePlasma], TexFull4);
    GameCanvas.TexMap(pBounds4(i * 256, j * 256, 256, 256),
     clWhite4);
   end;

 for j:= 0 to (ClientHeight div 64) do
  for i:= 0 to (ClientWidth div 64) do
   begin
    GameCanvas.UseImage(GameImages[imageScanline], TexFull4);
    GameCanvas.TexMap(pBounds4(i * 64, j * 64, 64, 64),
     clWhite4, deMultiply);
   end;

 GameFonts[fontTranceform].TextOut(
  Point2(4.0, 4.0),
  'fps: ' + IntToStr(Timer.FrameRate),
  cColor2($FFD1FF46, $FF3EB243), 1.0);
end;

//---------------------------------------------------------------------------
procedure TMainForm.WMDisplayChange(var message: TMessage);
begin
 // This event happens when user changes screen resolution.
 //
 // We also detect if the screen resolution has changed because of our
 // full screen mode, in which case we simply exit.
 if (Tag = 1) then Exit;

 if (GameDevice <> nil)and(GameDevice.Active) then GameDevice.Reset();
end;

//---------------------------------------------------------------------------
procedure TMainForm.UploadConversion(Bits: Pointer; Pitch: Integer;
 Format: TAsphyrePixelFormat);
var
 i: Integer;
begin
 for i:= 0 to Surface.Height - 1 do
  begin
   Pixel32toXArray(Surface.Scanline[i], Bits, Format, Surface.Width);
   Inc(Integer(Bits), Pitch);
  end;
end;

//---------------------------------------------------------------------------
procedure TMainForm.UploadNative(Bits: Pointer; Pitch: Integer);
var
 i: Integer;
begin
 for i:= 0 to Surface.Height - 1 do
  begin
   Move(Surface.Scanline[i]^, Bits^, Surface.Width * 4);
   Inc(Integer(Bits), Pitch);
  end;
end;

//---------------------------------------------------------------------------
procedure TMainForm.DoPlasma();
var
 i, j, Xadd, Cadd: Integer;
 Pixel: PLongword;
 Index: Integer;
 Bits : Pointer;
 Pitch: Integer;
begin
 for j:= 0 to 255 do
  begin
   Pixel:= Surface.Scanline[j];

   // plasma shifts
   Xadd:= SinTab[((j shl 2) + iShift) and $3FF];
   Cadd:= CosTab[((j shl 2) + jShift) and $3FF];

   // render scanline
   for i:= 0 to 255 do
    begin
     Index:= (SinTab[((i shl 2) + Xadd) and $3FF] + Cadd + (PalIndex * 4)) and $3FF;
     if (Index > 511) then Index:= 1023 - Index;

     Pixel^:= PaletteTab[((Index div 4) + PalIndex) and $3FF];
     Inc(Pixel);
    end;
  end;

 with GameImages[imagePlasma].Texture[0] do
  begin
   Lock(Bounds(0, 0, 256, 256), Bits, Pitch);

   if (Bits <> nil)and(Pitch > 0) then
    begin
     if (Format = apf_A8R8G8B8) then UploadNative(Bits, Pitch)
      else UploadConversion(Bits, Pitch, Format);

     Unlock();
    end;
  end;
end;

//---------------------------------------------------------------------------
initialization
  {$I MainFm.lrs}

//---------------------------------------------------------------------------
end.
