diff options
author | Graeme Geldenhuys <graemeg@gmail.com> | 2013-04-05 10:12:37 +0100 |
---|---|---|
committer | Graeme Geldenhuys <graemeg@gmail.com> | 2013-04-05 10:12:37 +0100 |
commit | d4144394608a6f12e1f82529d7ffb5da3f098a41 (patch) | |
tree | 14cc6ccebb726982853f7f23ce25c7cef53e9272 /docview/src | |
parent | 135c1deac21d749c6c1093e1740d3883d00d99ec (diff) | |
download | fpGUI-d4144394608a6f12e1f82529d7ffb5da3f098a41.tar.xz |
docview: Enabled support for reading images from INF files. (WIP)
This is still Work-In-Progress because the images are displayed, but
sometimes incorrectly, or with a wrong color palette. Either way, this
is progress, and very long overdue. ;-)
Diffstat (limited to 'docview/src')
-rw-r--r-- | docview/src/HelpBitmap.pas | 284 | ||||
-rw-r--r-- | docview/src/docview.lpi | 8 | ||||
-rw-r--r-- | docview/src/docview.lpr | 2 | ||||
-rw-r--r-- | docview/src/frm_main.pas | 3 | ||||
-rw-r--r-- | docview/src/lzwdecompress.pas | 263 |
5 files changed, 304 insertions, 256 deletions
diff --git a/docview/src/HelpBitmap.pas b/docview/src/HelpBitmap.pas index ecce808f..692bf64d 100644 --- a/docview/src/HelpBitmap.pas +++ b/docview/src/HelpBitmap.pas @@ -26,7 +26,7 @@ unit HelpBitmap; interface uses - Classes, SysUtils, fpg_main, ctypes, + Classes, SysUtils, fpg_main, IPFFileFormatUnit; type @@ -83,7 +83,6 @@ type _UncompressedBlockSize: longint; function GetPaletteSize: longint; procedure BitmapError(Msg: string); - procedure DecompressLZW(var Buffer: Pointer; const Count: integer; var NewBuffer: PByte; var NewCount: integer); procedure ReadBitmapData( Blocks: TList; TotalSize: longint ); public constructor CreateFromHelpFile(var AFileHandle: TFileStream; Offset: longint); @@ -91,19 +90,13 @@ type 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; + nvUtilities, + Math, + LZWDecompress, + fpg_imgfmt_bmp; const BFT_bMAP =$4d62; // 'bM' @@ -120,9 +113,15 @@ type _Size: uint16; _CompressionType: uint8; _Data: PBYTE; + constructor Create; destructor Destroy; override; end; +constructor TBitmapBlock.Create; +begin + _Data := nil; +end; + destructor TBitmapBlock.Destroy; begin FreeMem( _Data ); @@ -137,7 +136,6 @@ var BytesRead: longint; Block: TBitmapBlock; - p: pointer; Blocks: TList; BlockIndex: longint; ImageType: uint16; @@ -172,7 +170,8 @@ begin if _Header.usType <> BFT_bMAP then raise EHelpBitmapException.Create( 'Invalid bitmap header' ); - _Header.usType := $4d42; // sibyl only accepts 'BM' not 'bM' +// Graeme: we don't need to do this any more. It was only for Sybil +// _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 @@ -192,7 +191,7 @@ begin _BitsSize := LineSize * _Header.cy; // Correct header offset - it is wrong in the header (why?) - _Header.OffBits := sizeof( _Header ) + GetPaletteSize; // TODO: Graeme, double check this! + _Header.OffBits := sizeof( _Header ) + GetPaletteSize; // Load palette if _Header.cBitCount <= 8 then @@ -204,7 +203,7 @@ begin end; // Read data header - FillChar( DataHeader, sizeof( DataHeader ), 0 ); +// FillChar( DataHeader, sizeof( DataHeader ), 0 ); bytes := FileHandle.Read(DataHeader, SizeOf(DataHeader)); if bytes <> SizeOf(DataHeader) then raise EHelpBitmapException.Create( 'Failed to read DataHeader.' ); @@ -268,227 +267,7 @@ begin inherited Destroy; end; -procedure THelpBitmap.DecompressLZW(var Buffer: Pointer; const Count: Integer; var NewBuffer: PByte; var NewCount: integer); -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 ); +procedure THelpBitmap.ReadBitmapData( Blocks: TList; TotalSize: longint ); var BytesWritten: longint; BytesWrittenFromBlock: longword; @@ -501,13 +280,15 @@ var BlockIndex: longint; BitmapData: PBYTE; ptr: PByte; + i: integer; + img: TfpgImage; begin BitmapOutputPointer := nil; BitmapData := nil; ptr := nil; // Allocate memory to store the bitmap - Bitmapdata := GetMem( TotalSize ); + BitmapData := GetMem( TotalSize ); // Copy header to bitmap MemCopy( _Header, BitmapData^, sizeof( _Header ) ); @@ -535,16 +316,11 @@ begin 2: // LZW compression begin - // decompress block - if not Assigned( LZWDecompressBlock )then - raise EHelpBitmapException.Create( 'Cannot decode bitmap - DLL not found' ); - -// DecompressLZW(Block._Data, Block._Size); - //LZWDecompressBlock( Block._Data, - // BitmapOutputPointer, - // Block._Size, - // BytesWrittenFromBlock, - // lastOutByte ); + LZWDecompressBlock( Block._Data, + Block._Size, + BitmapOutputPointer, + BytesWrittenFromBlock, + lastOutByte ); inc( BytesWritten, BytesWrittenFromBlock ); @@ -577,9 +353,13 @@ begin > BitmapData + TotalSize ) then assert( false ); - inc( BitmapOutputPointer, BytesWrittenFromBlock ); +{ NOTE: This doesn't seem right. It moves the pointer so later the moving of data to + ImageData will be wrong! } +// inc( BitmapOutputPointer, BytesWrittenFromBlock ); TPersistentObjectState end; + i := TotalSize + SizeOf(_Header) + GetPaletteSize; + img := CreateImage_BMP(BitmapData, i); AllocateImage(32, _Header.cx, _Header.cy); @@ -600,10 +380,10 @@ begin writeln('------------- END -------------'); {$ENDIF} - if TotalSize <> ImageDataSize then - writeln('Warning: INF Bitmap size and allocated bitmap size are different. ', TotalSize, ' vs ', ImageDataSize); - Move(BitmapData^, ImageData^, TotalSize); +// Move(BitmapOutputPointer^, ImageData^, ImageDataSize); + Move(img.ImageData^, self.ImageData^, img.ImageDataSize); UpdateImage; + img.Free; FreeMem( BitmapData, TotalSize ); end; diff --git a/docview/src/docview.lpi b/docview/src/docview.lpi index aa570406..6fc2c4cb 100644 --- a/docview/src/docview.lpi +++ b/docview/src/docview.lpi @@ -23,6 +23,7 @@ <RunParams> <local> <FormatVersion Value="1"/> + <CommandLineParams Value="/data/devel/tests/inf_test/test2.inf"/> <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> </local> </RunParams> @@ -31,7 +32,7 @@ <PackageName Value="fpgui_toolkit"/> </Item1> </RequiredPackages> - <Units Count="36"> + <Units Count="37"> <Unit0> <Filename Value="docview.lpr"/> <IsPartOfProject Value="True"/> @@ -206,6 +207,11 @@ <IsPartOfProject Value="True"/> <UnitName Value="frm_bookmarks"/> </Unit35> + <Unit36> + <Filename Value="lzwdecompress.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="LZWDecompress"/> + </Unit36> </Units> </ProjectOptions> <CompilerOptions> diff --git a/docview/src/docview.lpr b/docview/src/docview.lpr index ad71b43a..0bee1dbe 100644 --- a/docview/src/docview.lpr +++ b/docview/src/docview.lpr @@ -13,7 +13,7 @@ uses RichTextStyleUnit, CanvasFontManager, ACLStringUtility, RichTextDocumentUnit, RichTextView, RichTextLayoutUnit, RichTextDisplayUnit, dvconstants, dvHelpers, frm_configuration, HelpBitmap, frm_text, frm_note, HelpNote, HelpBookmark, - frm_bookmarks; + frm_bookmarks, LZWDecompress; {$IFDEF WINDOWS} {$R docview.rc} diff --git a/docview/src/frm_main.pas b/docview/src/frm_main.pas index 090916a3..b88b9206 100644 --- a/docview/src/frm_main.pas +++ b/docview/src/frm_main.pas @@ -2508,8 +2508,7 @@ begin if ImageIndices.Count > 0 then begin - { TODO -oGraeme : We do not support images yet } -// THelpFile(CurrentTopic.HelpFile).GetImages(ImageIndices, FImages); + THelpFile(CurrentTopic.HelpFile).GetImages(ImageIndices, FImages); end; ImageIndices.Free; diff --git a/docview/src/lzwdecompress.pas b/docview/src/lzwdecompress.pas new file mode 100644 index 00000000..5f886f23 --- /dev/null +++ b/docview/src/lzwdecompress.pas @@ -0,0 +1,263 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + LZW decompression code for uncompressing IPF bitmaps. +} + +unit LZWDecompress; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, types; + +procedure LZWDecompressBlock( pbInput: pByte; + number_bytes: LongWord; + pbOutput: PBYTE; + Var bytesOut: LongWord; + Var FinalCode: byte ); + +Implementation + +(* +/******************************************************************** + * * + * LZW decompression * + * * + *******************************************************************/ + +/* + * This is based on code (W) by Peter Fitzsimmons, pfitz@ican.net. + * His liner notes in the original: + * has its roots in a June 1990 + * DDJ article "LZW REVISITED", by Shawn M. Regan + * --=>revision history<=-- + * 1 lzw.c 21-Aug-96,2:24:36,`PLF' ; + * 2 lzw.c 24-Aug-96,2:27:24,`PLF' wip + * + * The code has been modified to take the input not from an + * open file, but from any memory region. For this, a double + * pointer is used, which must be passed to LZWDecompressBlock. + * I've also added a few comments for clarity. + * + * Ported to Sibyl Pascal by Aaron Lawrence + * Variables renamed etc to make things clearer. + */ +*) +// -- Stuff for LZW decompression -- */ +const INIT_BITS = 9; +const MAX_BITS = 12; //PLF Tue 95-10-03 02:16:56*/ +const HASHING_SHIFT = MAX_BITS - 8; + +{if MAX_BITS == 15 +const TABLE_SIZE 36768 +#elif MAX_BITS == 14 +const TABLE_SIZE 18041 +#elif MAX_BITS == 13 +const TABLE_SIZE 9029 +#else} +// For max_bits = 12: +const TABLE_SIZE = 5021; + +const CLEAR_TABLE = 256; +const TERMINATOR = 257; +const FIRST_CODE = 258; + +function MaxValNBits( N: word ): word; +begin + Result:= ( 1 shl n ) - 1; +end; + +var + prefix_code: array[ 0..TABLE_SIZE ] of longword; + append_character: array[ 0..TABLE_SIZE ] of Byte; + decode_stack: array[ 0..10000 ] of byte; + bitsPerCode: longint; + maxDictionaryCode: longint; + +(* + * decode_string: + * + *) +function decode_string( buffer: PByte; code: longword ): PByte; +var + i: longint; +begin + i:= 0; + + while Code > 255 do + begin + buffer^:= append_character[ Code ]; + inc( Buffer ); + code:= prefix_code[ code ]; + + inc( i ); + if i > High( decode_stack ) then + assert( false, 'Out of space decompressing bitmap!' ); + end; + + buffer^ := code; + Result:= buffer; +end; + +(* + * input_code: + * this function reads in bytes from the input + * stream. + *) + +var + bytes_out: longword = 0; + input_bit_count: longword = 0; + input_bit_buffer: longword = 0; + +// I think this simply reads the next bitsPerCode bits of the input data +// returning the resulting code. +function input_code( var pbInput: PBYTE; bytes_to_read: longword ): longword; +var + return_value: longword; +begin + while input_bit_count <= 24 do + begin + if bytes_out <= bytes_to_read then + begin + input_bit_buffer:= input_bit_buffer + or + ( ( longword( pbInput^ ) shl (24 - input_bit_count) ) ); + inc( pbInput ); + end + else + input_bit_buffer:= input_bit_buffer + or + ( longword( 0 ) << ( 24 - input_bit_count ) ); + inc( bytes_out ); + inc( input_bit_count, 8 ); + end; + + return_value:= input_bit_buffer shr (32 - bitsPerCode); + input_bit_buffer:= input_bit_buffer shl bitsPerCode; + dec( input_bit_count, bitsPerCode ); + + if bytes_out > bytes_to_read then + begin + // flush static vars and quit */ + bytes_out:= 0; + input_bit_count:= 0; + input_bit_buffer:= 0; + Result:= TERMINATOR; + end + else + Result:= return_value; +end; + +// LZWDecompressBlock: +// this takes one of the INF bitmap blocks +// and decompresses it using LZW algorithms. + +procedure LZWDecompressBlock( pbInput: pByte; + number_bytes: LongWord; + pbOutput: PBYTE; + Var bytesOut: LongWord; + Var FinalCode: byte ); +var + nextAvailableCode: LongWord; + currentCode: LongWord; + lastCode: LongWord; + character: longword; + clear_flag: boolean; + theString: pByte; +begin + clear_flag:= true; + + nextAvailableCode:= FIRST_CODE; + bitsPerCode:= INIT_BITS; + maxDictionaryCode:= MaxValNBits( bitsPerCode ); + + bytesOut:= 0; + input_bit_count:= 0; + input_bit_buffer:= 0; + + // read the first code from input + currentCode:= input_code( pbInput, number_bytes ); + while currentCode <> TERMINATOR do + begin + if clear_flag then + begin + clear_flag:= false; + lastCode:= currentCode; + character:= currentCode; + + pbOutput^:= currentCode; + inc( pbOutput ); + FinalCode:= currentCode; + inc( BytesOut ); + end + else if currentCode = CLEAR_TABLE then + begin + clear_flag:= true; + nextAvailableCode:= FIRST_CODE; + bitsPerCode:= INIT_BITS; + maxDictionaryCode:= MaxValNBits( bitsPerCode ); + end + else + begin + if currentCode >= nextAvailableCode then + begin + decode_stack[ 0 ]:= character; + theString:= decode_string( Addr( decode_stack[ 1 ] ), + lastCode ); + end + else + theString:= decode_string( Addr( decode_stack[ 0 ] ), + currentCode ); + + character:= longword( theString^ ); + while theString >= Addr( decode_stack[ 0 ] ) do + begin + FinalCode:= theString^; + + pbOutput^:= theString^; + inc( pbOutput ); + dec( TheString ); + + inc( BytesOut ); + end; + + if nextAvailableCode <= maxDictionaryCode then + begin + prefix_code[ nextAvailableCode ]:= lastCode; + append_character[ nextAvailableCode ]:= character; + + inc( nextAvailableCode ); + + if ( nextAvailableCode = maxDictionaryCode ) and ( bitsPerCode < MAX_BITS ) then + begin + // expand dictionary + inc( bitsPerCode ); + maxDictionaryCode:= MaxValNBits( bitsPerCode ); + end; + end; + + lastCode:= currentCode; + end; + + // Read next code from input + currentCode:= input_code( pbInput, number_bytes ); + end; +end; + + +End. |