Converted NewView HelpBitmap unit to DocView

* Code is untested but compiles *

1 files changed, 564 insertions, 0 deletions

diff --git a/docview/src/HelpBitmap.pas b/docview/src/HelpBitmap.pas
new file mode 100644
index 00000000..35730fd1
--- /dev/null
+++ b/docview/src/HelpBitmap.pas
@@ -0,0 +1,564 @@
+unit HelpBitmap;
+
+interface
+
+// Encapsulates a bitmap as stored in a IPF file.
+// Once created from file data they can be used as a normal bitmap.
+
+uses
+  Classes, SysUtils, fpg_main, ctypes,
+  IPFFileFormatUnit;
+
+type
+  EHelpBitmapException = class( Exception );
+
+
+  // Lead part of BITMAPARRAYFILEHEADER
+  INFBITMAPARRAYHEADER = packed record
+    usType: uint16;    // 'BA', 16706
+    cbSize: uint32;     // Size of the BITMAPARRAYFILEHEADER structure in bytes.
+    offNext: uint32;    // Offset of the next BITMAPARRAYFILEHEADER structure from the start of the file.
+    cxDisplay: uint16; // Device width, in pels.
+    cyDisplay: uint16; // Device height, in pels.
+  end;
+
+
+  INFBITMAPHEADER = packed record
+    // BITMAP FILE HEADER
+    usType: uint16; // = 'bM'
+    cbSize: uint32;
+    xHotspot: uint16;
+    yHotspot: uint16;
+    offBits: uint32; // =size(hdr)+size(palette)
+    // BITMAP INFO HEADER
+    cbFIx: uint32; // =size(info_hdr) (usually = 12?)
+    cx: uint16; // width size
+    cy: uint16; // height size
+    cPlanes: uint16; // planes, =1   (always seems to be one)
+    cBitCount: uint16;    // bits per pixel
+                          // followed by RGB triples if <= 8bpp
+  end;
+
+  TRGB = packed record
+    Blue: uint8;
+    Green: uint8;
+    Red: uint8;
+  end;
+
+  TRGBA = packed record
+    Blue: uint8;
+    Green: uint8;
+    Red: uint8;
+    Reserved: uint8;
+  end;
+
+
+  THelpBitmap = class( TfpgImage )
+  protected
+    _Header: INFBITMAPHEADER;
+    _PaletteColorCount: longint;
+    _pPalette: ^TRGB;
+    _BitsSize: longint;
+    FileHandle: TFileStream;
+    _UncompressedBlockSize: longint;
+    function GetPaletteSize: longint;
+    procedure BitmapError(Msg: string);
+    procedure DecompressLZW(var Buffer: Pointer; var Count: PtrInt);
+    procedure ReadBitmapData( Blocks: TList; TotalSize: longint );
+  public
+    constructor CreateFromHelpFile(AFileHandle: TFileStream; Offset: longint);
+    destructor Destroy; override;
+  end;
+
+
+var
+  LZWDecompressBlock: function( pInput: PBYTE;
+                               pOutput: PBYTE;
+                               bytesIn: uint32;
+                               Var bytesOut: uint32;
+                               Var FinalCode: byte ): Boolean;
+//  APIENTRY;
+//  'newview' index 1;
+
+implementation
+
+uses
+  nvUtilities, Math, fpg_imgfmt_bmp;
+
+const
+  BFT_bMAP =$4d62; // 'bM'
+  BFT_BITMAP_ARRAY = $4142; // 'BA'
+
+type
+  INFBITMAPDATAHEADER = packed record
+    ulTotalSize: uint32;
+    usUncompressedBlockSize: uint16; // bytes per block, after decompression
+  end;
+
+  TBitmapBlock = class(TObject)
+    _Data: PBYTE;
+    _Size: uint16;
+    _CompressionType: uint8;
+    destructor Destroy; override;
+  end;
+
+destructor TBitmapBlock.Destroy;
+begin
+  FreeMem( _Data );
+  inherited Destroy;
+end;
+
+constructor THelpBitmap.CreateFromHelpFile(AFileHandle: TFileStream; Offset: longint);
+var
+  WordsPerLine: longint;
+  LineSize: longint;
+  DataHeader: INFBITMAPDATAHEADER;
+  BytesRead: longint;
+
+  Block: TBitmapBlock;
+  p: pointer;
+  Blocks: TList;
+  BlockIndex: longint;
+  ImageType: uint16;
+  BitmapArrayHeader: INFBITMAPARRAYHEADER;
+  bytes: integer;
+begin
+  FileHandle := AFileHandle;
+
+  FileHandle.Seek(Offset, soBeginning);
+  bytes := FileHandle.Read(ImageType, sizeof(ImageType));
+  if bytes <> SizeOf(ImageType) then
+    raise EHelpBitmapException.Create( 'Failed to read ImageType.' );
+
+  if ImageType = BFT_BITMAP_ARRAY then
+  begin
+    // skip array header and read first bitmap only
+    FileHandle.Seek(Sizeof( BitmapArrayHeader ) - sizeof( ImageType ),  soCurrent);
+  end
+  else
+  begin
+    // skip back over imagetype bytes to read header.
+    FileHandle.Seek(- sizeof( ImageType ),  soCurrent);
+  end;
+
+  // Read bitmap header
+  bytes := FileHandle.Read(_Header, SizeOf(_Header));
+  if bytes <> SizeOf(_Header) then
+    raise EHelpBitmapException.Create( 'Failed to read Header.' );
+
+  // Check it's got a valid type
+  if _Header.usType <> BFT_bMAP then
+    raise EHelpBitmapException.Create( 'Invalid bitmap header' );
+
+  _Header.usType := $4d42; // sibyl only accepts 'BM' not 'bM'
+
+  // We can only parse bitmaps with 1 colour plane
+  // (I can't be bothered and have never seen bitmaps
+  //  with more than 1 color plane)
+  if _Header.cPlanes <> 1 then
+    exit;
+
+  _PaletteColorCount := 0;
+  if _Header.cBitCount < 24 then
+    _PaletteColorCount := 1 shl _Header.cBitCount;
+
+  // OS/2 always rounds bitmap rows up to a word:
+  WordsPerLine := ( _Header.cBitCount * _Header.cx + 31 ) div 32;
+  LineSize := WordsPerLine * 4;
+
+  // Total size of the bitmap pixel data
+  _BitsSize := LineSize * _Header.cy;
+
+  // Correct header offset - it is wrong in the header (why?)
+  _Header.OffBits := sizeof( _Header ) + GetPaletteSize;           // TODO: Graeme, double check this!
+
+  // Load palette
+  _pPalette := GetMem( GetPaletteSize );
+  bytes := FileHandle.Read(_pPalette, GetPaletteSize);
+  if bytes <> GetPaletteSize then
+    raise EHelpBitmapException.Create( 'Failed to read Palette.' );
+
+  // Read data header
+  bytes := FileHandle.Read(DataHeader, SizeOf(DataHeader));
+  if bytes <> GetPaletteSize then
+    raise EHelpBitmapException.Create( 'Failed to read DataHeader.' );
+  _UncompressedBlockSize := DataHeader.usUncompressedBlockSize;
+
+  // For counting total size, we have already read some bytes:
+  // the uncompressedblocksize field
+  BytesRead := sizeof( DataHeader.usUncompressedBlockSize );
+  Blocks := TList.Create;
+
+  while BytesRead < DataHeader.ulTotalSize do
+  begin
+    Block := TBitmapBlock.Create;
+
+    // Read the block size
+    FileHandle.Read(Block._Size, SizeOf(Block._Size));
+    inc( BytesRead, sizeof( Block._Size ) );
+
+    // Read the compression type
+    FileHandle.Read(Block._CompressionType, SizeOf(Block._CompressionType));
+    inc( BytesRead, sizeof( Block._CompressionType ) );
+
+    // since size in the file includes this compression type field, subtract it
+    dec( Block._Size, sizeof( Block._CompressionType ) );
+
+    // Now read the block
+    Block._Data := GetMem( Block._Size );
+    FileHandle.Read(Block._Data, Block._Size);
+
+    inc( BytesRead, Block._Size  );
+
+    Blocks.Add( Block );
+
+  end;
+  ReadBitmapData( Blocks, sizeof( _Header ) + GetPaletteSize + _BitsSize );
+
+  for BlockIndex := 0 to Blocks.Count - 1 do
+  begin
+    Block := TBitmapBlock(Blocks[ BlockIndex ]);
+    Block.Free;
+  end;
+
+  Blocks.Free;
+end;
+
+function THelpBitmap.GetPaletteSize: longint;
+begin
+  Result := sizeof( TRGB ) * _PaletteColorCount;
+end;
+
+procedure THelpBitmap.BitmapError(Msg: string);
+begin
+  //Msg:=Msg+' at position '+IntToStr(s.Position);
+  //if fStartPos>0 then
+  //  Msg:=Msg+'(BitmapPosition='+IntToStr(fStartPos)+')';
+  raise EHelpBitmapException.Create(Msg);
+end;
+
+destructor THelpBitmap.Destroy;
+begin
+  FreeMem( _pPalette );
+  inherited Destroy;
+end;
+
+procedure THelpBitmap.DecompressLZW(var Buffer: Pointer; var Count: PtrInt);
+type
+  TLZWString = packed record
+    Count: integer;
+    Data: PByte;
+  end;
+  PLZWString = ^TLZWString;
+const
+  ClearCode = 256; // clear table, start with 9bit codes
+  EoiCode = 257; // end of input
+var
+  NewBuffer: PByte;
+  NewCount: PtrInt;
+  NewCapacity: PtrInt;
+  SrcPos: PtrInt;
+  SrcPosBit: integer;
+  CurBitLength: integer;
+  Code: Word;
+  Table: PLZWString;
+  TableCapacity: integer;
+  TableCount: integer;
+  OldCode: Word;
+
+  function GetNextCode: Word;
+  var
+    v: Integer;
+  begin
+    Result:=0;
+    // CurBitLength can be 9 to 12
+    //writeln('GetNextCode CurBitLength=',CurBitLength,' SrcPos=',SrcPos,' SrcPosBit=',SrcPosBit,' ',hexstr(PByte(Buffer)[SrcPos],2),' ',hexstr(PByte(Buffer)[SrcPos+1],2),' ',hexstr(PByte(Buffer)[SrcPos+2],2));
+    // read two or three bytes
+    if CurBitLength+SrcPosBit>16 then begin
+      // read from three bytes
+      if SrcPos+3>Count then BitmapError('LZW stream overrun');
+      v:=PByte(Buffer)[SrcPos];
+      inc(SrcPos);
+      v:=(v shl 8)+PByte(Buffer)[SrcPos];
+      inc(SrcPos);
+      v:=(v shl 8)+PByte(Buffer)[SrcPos];
+      v:=v shr (24-CurBitLength-SrcPosBit);
+    end else begin
+      // read from two bytes
+      if SrcPos+2>Count then BitmapError('LZW stream overrun');
+      v:=PByte(Buffer)[SrcPos];
+      inc(SrcPos);
+      v:=(v shl 8)+PByte(Buffer)[SrcPos];
+      if CurBitLength+SrcPosBit=16 then
+        inc(SrcPos);
+      v:=v shr (16-CurBitLength-SrcPosBit);
+    end;
+    Result:=v and ((1 shl CurBitLength)-1);
+    SrcPosBit:=(SrcPosBit+CurBitLength) and 7;
+    //writeln('GetNextCode END SrcPos=',SrcPos,' SrcPosBit=',SrcPosBit,' Result=',Result,' Result=',hexstr(Result,4));
+  end;
+
+  procedure ClearTable;
+  var
+    i: Integer;
+  begin
+    for i:=0 to TableCount-1 do
+      ReAllocMem(Table[i].Data,0);
+    TableCount:=0;
+  end;
+
+  procedure InitializeTable;
+  begin
+    CurBitLength:=9;
+    ClearTable;
+  end;
+
+  function IsInTable(Code: word): boolean;
+  begin
+    Result:=Code<258+TableCount;
+  end;
+
+  procedure WriteStringFromCode(Code: integer; AddFirstChar: boolean = false);
+  var
+    s: TLZWString;
+    b: byte;
+  begin
+    //WriteLn('WriteStringFromCode Code=',Code,' AddFirstChar=',AddFirstChar,' x=',(NewCount div 4) mod IDF.ImageWidth,' y=',(NewCount div 4) div IDF.ImageWidth,' PixelByte=',NewCount mod 4);
+    if Code<256 then begin
+      // write byte
+      b:=Code;
+      s.Data:=@b;
+      s.Count:=1;
+    end else if Code>=258 then begin
+      // write string
+      if Code-258>=TableCount then
+        BitmapError('LZW code out of bounds');
+      s:=Table[Code-258];
+    end else
+      BitmapError('LZW code out of bounds');
+    if NewCount+s.Count+1>NewCapacity then begin
+      NewCapacity:=NewCapacity*2+8;
+      ReAllocMem(NewBuffer,NewCapacity);
+    end;
+    System.Move(s.Data^,NewBuffer[NewCount],s.Count);
+    //for i:=0 to s.Count-1 do write(HexStr(NewBuffer[NewCount+i],2)); // debug
+    inc(NewCount,s.Count);
+    if AddFirstChar then begin
+      NewBuffer[NewCount]:=s.Data^;
+      //write(HexStr(NewBuffer[NewCount],2)); // debug
+      inc(NewCount);
+    end;
+    //writeln(',WriteStringFromCode'); // debug
+  end;
+
+  procedure AddStringToTable(Code, AddFirstCharFromCode: integer);
+  // add string from code plus first character of string from code as new string
+  var
+    b1, b2: byte;
+    s1, s2: TLZWString;
+    p: PByte;
+  begin
+    //WriteLn('AddStringToTable Code=',Code,' FCFCode=',AddFirstCharFromCode,' TableCount=',TableCount,' TableCapacity=',TableCapacity);
+    // grow table
+    if TableCount>=TableCapacity then begin
+      TableCapacity:=TableCapacity*2+128;
+      ReAllocMem(Table,TableCapacity*SizeOf(TLZWString));
+    end;
+    // find string 1
+    if Code<256 then begin
+      // string is byte
+      b1:=Code;
+      s1.Data:=@b1;
+      s1.Count:=1;
+    end else if Code>=258 then begin
+      // normal string
+      if Code-258>=TableCount then
+        BitmapError('LZW code out of bounds');
+      s1:=Table[Code-258];
+    end else
+      BitmapError('LZW code out of bounds');
+    // find string 2
+    if AddFirstCharFromCode<256 then begin
+      // string is byte
+      b2:=AddFirstCharFromCode;
+      s2.Data:=@b2;
+      s2.Count:=1;
+    end else begin
+      // normal string
+      if AddFirstCharFromCode-258>=TableCount then
+        BitmapError('LZW code out of bounds');
+      s2:=Table[AddFirstCharFromCode-258];
+    end;
+    // set new table entry
+    Table[TableCount].Count:=s1.Count+1;
+    p:=nil;
+    GetMem(p,s1.Count+1);
+    Table[TableCount].Data:=p;
+    System.Move(s1.Data^,p^,s1.Count);
+    // add first character from string 2
+    p[s1.Count]:=s2.Data^;
+    // increase TableCount
+    inc(TableCount);
+    case TableCount+259 of
+      512,1024,2048: inc(CurBitLength);
+      4096: BitmapError('LZW too many codes');
+    end;
+  end;
+
+begin
+  if Count=0 then exit;
+  //WriteLn('TFPReaderTiff.DecompressLZW START Count=',Count);
+  //for SrcPos:=0 to 19 do
+  //  write(HexStr(PByte(Buffer)[SrcPos],2));
+  //writeln();
+
+  NewBuffer:=nil;
+  NewCount:=0;
+  NewCapacity:=Count*2;
+  ReAllocMem(NewBuffer,NewCapacity);
+
+  SrcPos:=0;
+  SrcPosBit:=0;
+  CurBitLength:=9;
+  Table:=nil;
+  TableCount:=0;
+  TableCapacity:=0;
+  try
+    repeat
+      Code:=GetNextCode;
+      //WriteLn('TFPReaderTiff.DecompressLZW Code=',Code);
+      if Code=EoiCode then break;
+      if Code=ClearCode then begin
+        InitializeTable;
+        Code:=GetNextCode;
+        //WriteLn('TFPReaderTiff.DecompressLZW after clear Code=',Code);
+        if Code=EoiCode then break;
+        if Code=ClearCode then
+          BitmapError('LZW code out of bounds');
+        WriteStringFromCode(Code);
+        OldCode:=Code;
+      end else begin
+        if Code<TableCount+258 then begin
+          WriteStringFromCode(Code);
+          AddStringToTable(OldCode,Code);
+          OldCode:=Code;
+        end else if Code=TableCount+258 then begin
+          WriteStringFromCode(OldCode,true);
+          AddStringToTable(OldCode,OldCode);
+          OldCode:=Code;
+        end else
+          BitmapError('LZW code out of bounds');
+      end;
+    until false;
+  finally
+    ClearTable;
+    ReAllocMem(Table,0);
+  end;
+
+  ReAllocMem(NewBuffer,NewCount);
+  FreeMem(Buffer);
+  Buffer:=NewBuffer;
+  Count:=NewCount;
+end;
+
+
+procedure THelpBitmap.ReadBitmapData( Blocks: TList;
+                                      TotalSize: longint );
+var
+  BytesWritten: longint;
+  BytesWrittenFromBlock: longword;
+  BytesRemainingInBlock: longword;
+  BytesRemainingInBitmap: longword;
+  FillerBytesRequired: longint;
+  lastOutByte: byte;
+  BitmapOutputPointer: PByte;
+  Block: TBitmapBlock;
+  BlockIndex: longint;
+  BitmapData: PBYTE;
+  ptr: PByte;
+begin
+  // Allocate memory to store the bitmap
+  Bitmapdata := GetMem( TotalSize );
+
+  // Copy header to bitmap
+  MemCopy( _Header, BitmapData, sizeof( _Header ) );
+
+  // Copy palette into bitmap
+  ptr := BitmapData + sizeof( _Header );
+  MemCopy( _pPalette, ptr, GetPaletteSize );
+
+  BytesWritten := 0;
+
+  // Point to start writing to bitmap bits.
+  BitmapOutputPointer := BitmapData + sizeof( _Header ) + GetPaletteSize;
+
+  for BlockIndex := 0 to Blocks.Count - 1 do
+  begin
+    Block := TBitmapBlock(Blocks[ BlockIndex ]);
+
+    case Block._CompressionType of
+      0,1: // uncompressed (I'm not sure about 1)
+      begin
+        MemCopy( Block._Data, BitmapOutputPointer, Block._Size );
+        BytesWrittenFromBlock := Block._Size;
+        inc( BytesWritten, BytesWrittenFromBlock );
+      end;
+
+      2: // LZW compression
+      begin
+        // decompress block
+        if not Assigned( LZWDecompressBlock )then
+          raise EHelpBitmapException.Create( 'Cannot decode bitmap - DLL not found' );
+
+        LZWDecompressBlock( Block._Data,
+                            BitmapOutputPointer,
+                            Block._Size,
+                            BytesWrittenFromBlock,
+                            lastOutByte );
+
+        inc( BytesWritten, BytesWrittenFromBlock );
+
+        // If the uncompressed data stopped short then
+        // copy the final code (byte) into remaining bytes
+        if ( BytesWrittenFromBlock < _UncompressedBlockSize )
+          and ( BytesWritten < _BitsSize ) then
+        begin
+          BytesRemainingInBlock := _UncompressedBlockSize - BytesWrittenFromBlock;
+          BytesRemainingInBitmap := _BitsSize - BytesWritten;
+
+          FillerBytesRequired := Min( BytesRemainingInBlock,
+                                      BytesRemainingInBitmap );
+
+          FillMem( BitmapOutputPointer + BytesWrittenFromBlock,
+                   FillerBytesRequired,
+                   LastOutByte );
+          inc( BytesWritten, FillerBytesRequired );
+          inc( BytesWrittenFromBlock, FillerBytesRequired );
+        end;
+      end;
+      else
+        raise EHelpBitmapException.Create( 'Unrecognised bitmap block type' );
+    end; // case
+
+    assert( BytesWrittenFromBlock <= _UncompressedBlockSize );
+    assert( BytesWritten <= _BitsSize );
+
+    if ( BitmapOutputPointer + BytesWrittenFromBlock
+         > BitmapData + TotalSize ) then
+      assert( false );
+
+    inc( BitmapOutputPointer, BytesWrittenFromBlock );
+  end;
+
+
+  AllocateImage(32, _Header.cx, _Header.cy);
+  if TotalSize <> ImageDataSize then
+    writeln('Warning: INF Bitmap size and allocated bitmap size are different. ', TotalSize, ' vs ', ImageDataSize);
+  Move(BitmapData^, ImageData^, TotalSize);
+  UpdateImage;
+
+  FreeMem( BitmapData, TotalSize );
+end;
+
+
+end.