unit lazbridge;

{ *************************************************************************** }
{ Copyright (c) 2007 Theo Lustenberger                                        }
{                                                                             }
{ This software is provided "as-is".  This software comes without warranty    }
{ or garantee, explicit or implied.  Use this software at your own risk.      }
{ The author will not be liable for any damage to equipment, data, or         }
{ information that may result while using this software.                      }
{                                                                             }
{ By using this software, you agree to the conditions stated above.           }
{ *************************************************************************** }

{$MODE objfpc}{$H+}
{_$DEFINE VER_MINIMAL}
{$DEFINE NewIntfImage}
interface

uses Classes, SysUtils, Graphics, GraphType, InterfaceBase, LCLType,
  IntfGraphics, FPimage, LCLIntf, ExtDlgs, FileUtil, ExtCtrls,
  opbitmap{$IFNDEF VER_MINIMAL}, opbitmapformats{$ENDIF}

{$IFDEF LCLgtk2}
  , glib2, gdk2, gtk2, gtkDef, gtkProc
{$DEFINE gtk}
{$ENDIF}

{$IFDEF LCLgtk}
  , glib, gdk, gtk, gtkDef, gtkProc
{$DEFINE gtk}
{$ENDIF}
  ;


type

{ TMyIntfImage }

  TMyIntfImage = class(TLazIntfImage)
  public
    procedure CreateBitmapLateMask(var Bitmap, MaskBitmap: HBitmap;
      AlwaysCreateMask: boolean; const RawImage: TRawImage);
  end;

  { TOPOpenDialog }

{$IFNDEF VER_MINIMAL}
  TOPOpenDialog = class(TOpenPictureDialog)
  private
    FPreviewFilename: string;
  protected
    procedure UpdatePreview; override;
    function Execute: boolean; override;
  end;


  { TLazOPPicture }

  TLazOPPicture = class(TOPPicture)
  private
    fImage: TImage;
    fUpdateImageSize: Boolean;
  public
    constructor Create(Image: TImage);
    procedure DrawImage;
    property UpdateImageSize: Boolean read fUpdateImageSize write fUpdateImageSize;
  end;
{$ENDIF}

procedure AssignBitmapToOpBitmap(Bitmap: TBitmap; OpBitmap: TOpBitmap);
procedure AssignOpBitmapToBitmap(SourceBitmap: TOpBitmap; Bitmap: TBitmap; PreserveFormat: boolean = true);
procedure AssignOpBitmapToCanvas(OpBitmap: TOpBitmap; aCanvas: Graphics.TCanvas; X, Y: integer);
{$IFDEF gtk} //Experimental GTK Only
procedure GTKDrawRGB32Bitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY, SrcWidth, SrcHeight: Integer;
  SrcBitmap: TCanvasOPBitmap);
{$ENDIF}

implementation

procedure AssignBitmapToOpBitmap(Bitmap: TBitmap; OpBitmap: TOpBitmap);
var int: TLazIntfImage;
  i: integer;
  x, y: integer;
begin
  int := Bitmap.CreateIntfImage;
  OpBitmap.Width := int.Width;
  OpBitmap.Height := int.Height;
  OpBitmap.Pixelformat := PixelFormatFromBPP(Int.DataDescription.BitsPerPixel);
  for y := 0 to OpBitmap.Height - 1 do
    for x := 0 to OpBitmap.Width - 1 do
      OpBitmap.Pixels[X, Y] := Int.TColors[X, Y];
  if Bitmap.Transparent then
    OpBitmap.TransparentColor := Bitmap.TransparentColor else OPBitmap.Transparent := false;
  int.free;
end;


procedure AssignOpBitmapToBitmap(SourceBitmap: TOpBitmap; Bitmap: TBitmap; PreserveFormat: boolean = true);
var int: TMyIntfImage;
var bmph, mbmph: HBitmap;
  x, y: integer;
  pmask: PByte;
  rawi: TRawImage;
  OPBitmap: TOpBitmap;
begin
  if PreserveFormat then
  begin
    OpBitmap := TOPBitmap.create;
    OpBitmap.Assign(SourceBitmap);
  end else OpBitmap := SourceBitmap;

  Int := TMyIntfImage.Create(0, 0);
  {$ifndef NewIntfImage}
  Int.AutoCreateMask := false;
  {$endif}

  {$ifndef NewIntfImage}
  Int.GetDescriptionFromDevice(0);
  {$else}
  Int.DataDescription:=GetDescriptionFromDevice(0);
  {$endif}

   Int.Width := OpBitmap.Width;
  Int.Height := OpBitmap.Height;
  OpBitmap.Pixelformat := PixelFormatFromBPP(Int.DataDescription.BitsPerPixel);
  for y := 0 to OpBitmap.Height - 1 do
    for x := 0 to OpBitmap.Width - 1 do
      Int.TColors[X, Y] := OpBitmap.Pixels[X, Y];

  if OPBitmap.Transparent then
  begin
    int.GetRawImage(Rawi);
    {$ifndef NewIntfImage};
    rawi.MaskSize := OpBitmap.GetTransparentMask(0, pmask,
      Rawi.Description.AlphaBitOrder = riboReversedBits,
      TOPRawImageLineEnd(Rawi.Description.AlphaLineEnd));
    {$else}
    rawi.MaskSize := OpBitmap.GetTransparentMask(0, pmask,
      Rawi.Description.GetDescriptionFromAlpha.BitOrder=riboReversedBits,
     TOPRawImageLineEnd(Rawi.Description.GetDescriptionFromAlpha.LineEnd));
    {$endif}
    rawi.Mask := pmask;
(*    writeln(RawImageDescriptionAsString(@Rawi));
    writeln('bwid: ',OpBitmap.Width, ' bhei: ',OpBitmap.Height,' rmsiz:',Rawi.MaskSize); *)
    Int.CreateBitmapLateMask(bmph, mbmph, false, rawi);
  end else
  begin
    {$ifndef NewIntfImage};
    Int.CreateBitmap(bmph, mbmph, false);
    {$else}
    Int.CreateBitmaps(bmph, mbmph, false);
    {$endif}
  end;
  Bitmap.Free;
  Bitmap := TBitmap.Create;
  Bitmap.Handle := bmph;
  Bitmap.MaskHandle := mbmph;
  Int.free;
  if PreserveFormat then OPBitmap.free;
end;

procedure AssignOpBitmapToCanvas(OpBitmap: TOpBitmap; aCanvas: Graphics.TCanvas; X, Y: integer);
var Bmp: TBitmap;
begin
  Bmp := TBitmap.create;
  AssignOpBitmapToBitmap(OpBitmap, Bmp);
  aCanvas.Draw(X, Y, bmp);
  Bmp.free;
end;

{$IFDEF gtk} //Experimental GTK Only

procedure ClipDimension(ClipMin, ClipMax: Integer;
  var DstPos, SrcPos, SrcSize: Integer);
var
  C: Integer;
begin
  if ClipMin > DstPos then
  begin
    C := ClipMin - DstPos;
    Inc(SrcPos, C);
    Dec(SrcSize, C);
    DstPos := ClipMin;
  end;

  if ClipMax < DstPos + SrcSize then SrcSize := ClipMax - DstPos;
end;

procedure prepareCopyImage(Src, Dest: TCanvasOPBitmap; SrcX, SrcY, SrcWidth, SrcHeight: Integer);
var i: integer;
  PPix32: PPixel32;
  Temp: Byte;
begin
  Dest.PixelFormat := pf32bit;
  Src.PixelFormat := pf32bit;
  Dest.Width := SrcWidth + SrcX;
  Dest.Height := SrcHeight + SrcY;
  Dest.Canvas.CopyRectPlain32SwapRGB(Rect(0, 0, SrcWidth, SrcHeight), Src.Canvas, Rect(SrcX, SrcY, SrcWidth + SrcX, SrcHeight + SrcY));
end;


procedure GTKDrawRGB32Bitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY, SrcWidth, SrcHeight: Integer;
  SrcBitmap: TCanvasOPBitmap);
var
  Clip: TRect;
  Bitmap: TCanvasOPBitmap;
  P: TPoint;
  LL: Integer;
  PPix32: PPixel32;
  i: integer;
  Temp: Byte;
  NewClipMask: PGDKBitmap;
  pmask: PByte;
begin
  if (SrcBitmap = nil) or (SrcBitmap.Empty) then Exit;
  Bitmap := TCanvasOPBitmap.Create;
  prepareCopyImage(SrcBitmap, Bitmap, SrcX, SrcY, SrcWidth, SrcHeight);
  if SrcBitmap.Transparent then Bitmap.TransparentColor := ((SrcBitmap.TransparentColor and $FF0000) shr 16) +
    ((SrcBitmap.TransparentColor and $00FF00)) +
      ((SrcBitmap.TransparentColor and $0000FF) shl 16);

  if (Bitmap.Width <= 0) or (Bitmap.Height <= 0) then Exit;
  Widgetset.GetClipBox(Dest, @Clip);
  if (DstX >= Clip.Right) or (DstY >= Clip.Bottom) or
    (DstX + SrcWidth < Clip.Left) or (DstY + SrcHeight < Clip.Top) then Exit;

  ClipDimension(Clip.Left, Clip.Right, DstX, SrcX, SrcWidth);
  ClipDimension(Clip.Top, Clip.Bottom, DstY, SrcY, SrcHeight);

  P := GetDCOffset(TDeviceContext(Dest));

  Inc(DstX, P.X);
  Inc(DstY, P.Y);
  LL := Bitmap.Data.LineLength;

  NewClipMask := nil;

  if Bitmap.Transparent then
  begin
    {$ifndef NewIntfImage};
    TDeviceContext(Dest).ClipRegion := 0;
    {$else}
    TDeviceContext(Dest).ClipRegion := nil;
    {$endif}
    Bitmap.GetTransparentMask(0, pmask, false, rileByteBoundary);
    NewClipMask := gdk_bitmap_create_from_data(nil, PGchar(pmask), Bitmap.Width, Bitmap.Height);
    gdk_gc_set_clip_origin(TDeviceContext(Dest).GC, DstX, DstY);
    gdk_gc_set_clip_mask(TDeviceContext(Dest).GC, NewClipMask);

  end;

  gdk_draw_rgb_32_image(TDeviceContext(Dest).Drawable, TDeviceContext(Dest).GC,
    DstX, DstY, SrcWidth - SrcX, SrcHeight - SrcY, GDK_RGB_DITHER_NONE,
    Pguchar(@Bitmap.Data.ScanLine[0][0]), LL);

  if NewClipMask <> nil then
  begin
    gdk_bitmap_unref(NewClipMask);
    gdk_gc_set_clip_mask(TDeviceContext(Dest).GC, nil);
    gdk_gc_set_clip_rectangle(TDeviceContext(Dest).GC, nil);
  end;
  Bitmap.free;
end;

{$ENDIF}


{$IFNDEF VER_MINIMAL}

{ TOPOpenDialog }

procedure TOPOpenDialog.UpdatePreview;
var
  CurFilename: string;
  FileIsValid: boolean;
  OP: TOPPicture;
  LBPP: Integer;
begin
  CurFilename := FileName;
  if CurFilename = FPreviewFilename then exit;

  FPreviewFilename := CurFilename;
  FileIsValid := FileExists(FPreviewFilename)
    and (not DirPathExists(FPreviewFilename))
    and FileIsReadable(FPreviewFilename);
  if FileIsValid then
  try
    OP := TOPPicture.create;
    try
      OP.LoadFromFile(FPreviewFilename);
      LBPP := OP.Bitmap.BPP;
      OP.Bitmap.Transparent := false;
      AssignOpBitmapToBitmap(Op.Bitmap, ImageCtrl.Picture.Bitmap, false);
      PictureGroupBox.Caption := Format('(%dx%d BPP:%d)',
        [ImageCtrl.Picture.Width, ImageCtrl.Picture.Height, LBPP]);
    finally
      OP.free;
    end;
  except
    FileIsValid := False;
  end;
  if not FileIsValid then
    ClearPreview;
end;

function TOPOpenDialog.Execute: boolean;
begin
  Filter := OPGLoadFilters;
  result := inherited Execute;
end;

{$ENDIF}


{ TMyIntfImage }

procedure TMyIntfImage.CreateBitmapLateMask(var Bitmap, MaskBitmap: HBitmap;
  AlwaysCreateMask: boolean; const RawImage: TRawImage);
var
  ARawImage: TRawImage;
begin
  GetRawImage(ARawImage);
  ARawImage.Mask := RawImage.Mask;
  ARawImage.MaskSize := RawImage.MaskSize;
  {$ifdef NewIntfImage}
  if not RawImage_CreateBitmaps(ARawImage, Bitmap, MaskBitmap, AlwaysCreateMask)
  {$else}
  if not CreateBitmapFromRawImage(ARawImage, Bitmap, MaskBitmap, AlwaysCreateMask)
  {$endif}
    then
    raise FPImageException.Create('Failed to create bitmaps');
end;


{$IFNDEF VER_MINIMAL}

{ TLazOPPicture }

constructor TLazOPPicture.Create(Image: TImage);
begin
  inherited Create;
  fImage := Image;
  fUpdateImageSize := true;
end;

procedure TLazOPPicture.DrawImage;
begin
  if fImage <> nil then
  begin
    if fUpdateImageSize then fImage.SetBounds(0, 0, Bitmap.Width, Bitmap.Height);
    AssignOpBitmapToBitmap(Bitmap, fImage.Picture.Bitmap);
    fImage.invalidate;
  end;
end;

{$ENDIF}

initialization
{$IFDEF gtk}
  gdk_rgb_init;
{$ENDIF}

end.