unit FrameBuf;

interface

uses
  Windows, Graphics, LibV;

procedure FB_Init;
procedure FB_Shutdown;

function  FB_GetMaxX:integer;
function  FB_GetMaxY:integer;
procedure FB_SetMaxX(MaxX:integer);
procedure FB_SetMaxY(MaxY:integer);

procedure FB_Clear;
procedure FB_DrawPixel(x,y:integer;cindex:Byte);register;assembler;
procedure FB_DrawPixels1fv(x1,x2:vec_t;y:vec_t_array_p;nvert:integer;cindex:Byte);
procedure FB_DrawLine(x1,y1,x2,y2:integer;cindex:byte);
procedure FB_DrawHLine(x,y,x2:integer;cindex:Byte);
procedure FB_DrawVLine(x,y,y2:integer;cindex:Byte);
procedure FB_DrawVLines1fv(x1,x2,to_y:vec_t;y:vec_t_array_p;nvert:integer;cindex:Byte);
procedure FB_OutTextXY(x,y:integer;text:string);
procedure FB_BlitTo(DC : HDC;XDest,YDest,DestWidth,DestHeight:integer);

(*
 * Dangerous, for internal use only
 *)
procedure FB_DrawClippedPixel(x,y:integer;cindex:Byte);register;assembler;

implementation

var
  initialized : boolean;
  
  FB_WIDTH    : integer = 800;
  FB_HEIGHT   : integer = 600;

  ClipMaxX   : integer = 0;
  ClipMaxY  : integer = 0;

  Surface     : TBitmap;
  FrameBuffer : array[0..2048] of u8_t_array_p;
  CurIndex    : Byte = 255;
  Palette     : array[0..255] of TPALETTEENTRY;

function  FB_GetMaxX:integer;
begin
  Result := ClipMaxX;
end;

function  FB_GetMaxY:integer;
begin
  Result := ClipMaxY;
end;

procedure FB_SetMaxX(MaxX:integer);
begin
  if MaxX < 0 then
    exit;
  ClipMaxX := MaxX;
  if ClipMaxX > FB_WIDTH then
  begin
    FB_Shutdown;
    FB_Init;
  end;
end;

procedure FB_SetMaxY(MaxY:integer);
begin
  if MaxY < 0 then
    exit;
  ClipMaxY := MaxY;
  if ClipMaxY > FB_HEIGHT then
  begin
    FB_Shutdown;
    FB_Init;
  end;
end;

procedure FB_Clear;
var
  i : integer;
begin
  i:=0;
  while i <= ClipMaxY do
  begin
    FillChar(FrameBuffer[i][0],ClipMaxX+1,0);
    i := i+1;
  end;
end;

procedure FB_DrawPixel(x,y:integer;cindex:Byte);register;assembler;
asm
   // clip point to FB boundaries using UNSIGNED comparison
   cmp  edx, ClipMaxY
   ja   @@out
   cmp  eax, ClipMaxX
   ja   @@out
   // get scanline address
   mov  edx, dword ptr FrameBuffer[4 * edx]
   // write pixel
   mov  byte ptr edx[eax], cl
@@out:
end;

procedure FB_DrawClippedPixel(x,y:integer;cindex:Byte);register;assembler;
asm
   // get scanline address
   mov  edx, dword ptr FrameBuffer[4 * edx]
   // write pixel
   mov  byte ptr edx[eax], cl
end;

procedure FB_DrawHLine(x,y,x2:integer;cindex:Byte);
var
  i : integer;
begin
  if (y<0) or (y>ClipMaxY) then
     exit;
  if x>ClipMaxX then
    exit;
  if x<0 then
  begin
    if x2<0 then
      exit;
    x:=0;
    if x2 > ClipMaxX then
      x2 := ClipMaxX;
  end
  else
  begin
    // fixme
    if x2<x then
      exit;
    if x2 > ClipMaxX then
      x2 := ClipMaxX;
  end;
  for i:=x to x2 do
    FB_DrawClippedPixel(i,y,cindex);
end;

procedure FB_DrawVLine(x,y,y2:integer;cindex:Byte);
var
  i : integer;
begin
  if (x<0) or (x>ClipMaxX) then
     exit;
  if y>ClipMaxY then
    exit;
  if y<0 then
  begin
    if y2<0 then
      exit;
    y:=0;
    if y2 > ClipMaxY then
      y2 := ClipMaxY;
  end
  else
  begin
    // fixme
    if y2<y then
      exit;
    if y2 > ClipMaxY then
      y2 := ClipMaxY;
  end;
  for i:=y to y2 do
    FB_DrawClippedPixel(x,i,cindex);
end;

(*
 * BROKEN, DONT USE
 *
 * y2 must be less then y2
procedure FB_DrawVLine_(x,y1,y2:integer);register;assembler;
asm
  // eax = x; edx = y1; ecx = y2
  // clip points to FB boundaries using UNSIGNED comparison
  cmp  eax, ClipMaxX
  ja   @@out
  or   edx, edx
  jge  @@y1_min_ok
  xor  edx, edx
@@y1_min_ok:
  cmp  edx, ClipMaxY
  jle  @@y1_max_ok
  mov  edx, ClipMaxY
@@y1_max_ok:
  or   ecx, ecx
  jge  @@y2_min_ok
  xor  ecx, ecx
@@y2_min_ok:
  cmp  ecx, ClipMaxY // ?
  jle  @@y2_max_ok  // ?
  mov  ecx, ClipMaxY   // ?
@@y2_max_ok:
  sub  ecx, edx       // loop counter -> ecx
  inc  ecx
  or   ecx, ecx       // fixme: is this needed ?
  jle  @@out          // loop counter must be > 0
  push ebx
@@DrawNextPixel:
  // get scanline address
  mov  ebx, dword ptr FrameBuffer[4 * edx]
  // write pixel
  mov  byte ptr ebx[eax], 255
  inc  edx
  dec  ecx
  jge  @@DrawNextPixel
  pop  ebx
@@out:
end;
 *)

procedure FB_DrawPixels1fv(x1,x2:vec_t;y:vec_t_array_p;nvert:integer;cindex:byte);
var
  i  : integer;
  dx : vec_t;
begin
  if nvert < 1 then
  begin
    FB_DrawPixel(round(x1),round(y^[0]),cindex);
    exit;
  end;
  nvert := nvert-1;
  dx := (x2 - x1) / nvert;
  for i:=0 to nvert do
  begin
    FB_DrawPixel(round(x1),round(y^[i]),cindex);
    x1 := x1 + dx;
  end;
end;

procedure FB_DrawVLines1fv(x1,x2,to_y:vec_t;y:vec_t_array_p;nvert:integer;cindex:Byte);
var
  yt, i  : integer;
  dx : vec_t;
begin
  if nvert < 1 then
    exit;
  nvert := nvert-1;
  dx := (x2 - x1) / nvert;
  yt := round(to_y);
  for i:=0 to nvert do
  begin
    FB_DrawVLine(round(x1),round(y^[i]),yt,cindex);
    x1 := x1 + dx;
  end;
end;

procedure FB_DrawLine(x1,y1,x2,y2:integer;cindex:byte);
begin
  if cindex <> CurIndex then
  begin
    CurIndex := cindex;
    Surface.Canvas.Pen.Color:=RGB(Palette[cindex].peRed,
      Palette[cindex].peGreen,Palette[cindex].peBlue);
  end;
  Surface.Canvas.MoveTo(x1,y1);
  Surface.Canvas.LineTo(x2,y2);
end;

procedure FB_OutTextXY(x,y:integer;text:string);
begin
  Surface.Canvas.TextOut(x,y,text);
end;

procedure FB_BlitTo(DC : HDC;XDest,YDest,DestWidth,DestHeight:integer);
begin
  if Surface <> nil then
    BitBlt(DC,XDest,YDest,DestWidth,DestHeight,
      Surface.Canvas.Handle,0,0,SRCCOPY);
end;

procedure SetupPalette(bmp : TBitmap);
var
  ppal : ^TLOGPALETTE;
  i    : integer;
begin
  GetMem(ppal,2*sizeof(WORD)+256*sizeof(TPALETTEENTRY));
  ppal^.palVersion := $300;
  ppal^.palNumEntries := 256;
  for i:=0 to 255 do
  begin
    Palette[i].peRed := i;
    Palette[i].peGreen := i;
    Palette[i].peBlue := round(0.95 * i);
    Palette[i].peFlags := 0;
  end;
  Move(Palette,ppal^.palPalEntry,sizeof(Palette));
  bmp.Palette := CreatePalette(ppal^);
  FreeMem(ppal);
end;

procedure FB_Init;
var
  i : integer;
begin
  if initialized then
    exit;
  FB_WIDTH := GetSystemMetrics(SM_CXSCREEN);
  if ClipMaxX >= FB_WIDTH then
    FB_WIDTH := ClipMaxX+1;
  FB_HEIGHT := GetSystemMetrics(SM_CXSCREEN);
  if ClipMaxY >= FB_HEIGHT then
    FB_HEIGHT:= ClipMaxY+1;
  ClipMaxX := FB_WIDTH-1;
  ClipMaxY := FB_HEIGHT-1;
  Surface := TBitmap.Create;
  Surface.PixelFormat := pf8bit;
  SetupPalette(Surface);
  Surface.Width := FB_WIDTH;
  Surface.Height := FB_HEIGHT;
  i := 0;
  while i < FB_HEIGHT do
  begin
    FrameBuffer[i] := u8_t_array_p(Surface.Scanline[i]);
    i := i+1;
  end;
  SetBkMode(Surface.Canvas.Handle,TRANSPARENT);
  SetBkColor(Surface.Canvas.Handle,RGB(0,0,0));
  SetTextColor(Surface.Canvas.Handle,RGB(255,255,255));
  initialized := True;
end;

procedure FB_Shutdown;
begin
  if not initialized then
    exit;
  Surface.Free;
  initialized := False;
end;

initialization
  FB_Init;
finalization
  FB_Shutdown;
end.

