unit uGump;

interface

uses Classes, SysUtils, GR32, Dialogs, Graphics, uUtilities;

type TGump = class
private
        idxStream, mulStream : TMemoryStream;
public
        loaded : boolean;
        constructor Create;
        destructor Free;
        procedure Load( idxPath, mulPath : String );
        procedure Save( idxPath, mulPath : String );
        function GumpExists( Id : Integer ) : Boolean;
        function GetGump( Id : Integer ) : TBitmap32;
        procedure LoadGump( Id : Integer; FilePath : String );
        procedure Delete( Id : Integer );
        procedure ReIndex( idxPath, mulPath : String );
        procedure Encrypt( Id : Integer; var IndexRecord : TIndexRecord );
        procedure Decrypt( Id : Integer; var IndexRecord : TIndexRecord );
        function GetGumpCount : Integer;
        function GetGumpHeight( Id : Integer ) : Word;
        function GetGumpWidth( Id : Integer ) : Word;
end;

var     Gump : TGump;
        Gump2 : TGump;

implementation

uses    StrLib, uGaugeForm, uMulpatcher;

constructor TGump.Create;
begin
        idxStream := TMemoryStream.Create;
        mulStream := TMemoryStream.Create;
        loaded := false;
end;

destructor TGump.Free;
begin
        idxStream.Free;
        mulStream.Free;
end;

procedure TGump.Load( idxPath, mulPath : String );
begin
        idxStream.LoadFromFile( idxPath );
        mulStream.LoadFromFile( mulPath );
        loaded := true;
end;

procedure TGump.Save( idxPath, mulPath : String );
begin
        idxStream.SaveToFile( idxPath );
        mulStream.SaveToFile( mulPath );
end;

function TGump.GumpExists( Id : Integer ) : boolean;
var     IndexRec : TIndexRecord;
begin
        if not loaded then begin
                Result := false;
                exit;
        end;

        if Id*12 > idxStream.Size then begin
                Result := False;
                exit;
        end;

        idxStream.Seek( Id*12, soFromBeginning );
        idxStream.Read( IndexRec, sizeof( TIndexRecord ) );
        Decrypt( Id, IndexRec );

        if (IndexRec.Offset <> -1) and (IndexRec.Length > 0) then
                Result := true
        else
                Result := false;
end;

function TGump.GetGump( Id : Integer ) : TBitmap32;
var     Breite, Hoehe : Word;
        IndexRec : TIndexRecord;
        LookupList : PIntegerArray;
        Start : Integer;
        x, y, i, j, Size : integer;
        Buffer : Array[0..2048] of Record Value, Run : Word; end;
begin
        Result := TBitmap32.Create;

        idxStream.Seek( Id*12, soFromBeginning );
        idxStream.Read( IndexRec, 12 );
        Decrypt( Id, IndexRec );

        Breite := IndexRec.Extra shr 16;
        Hoehe := IndexRec.Extra and $FFFF;

        Result.Width := Breite;
        Result.Height := Hoehe;

        mulStream.Seek( IndexRec.Offset, soFromBeginning );
        GetMem( LookupList, Hoehe*4 );
        Start := mulStream.Position;
        mulStream.Read( LookupList^, Hoehe*4 );

        y := 0;
        while y < Hoehe do begin
                If y < Hoehe-1 then
                        Size := LookupList^[Y+1]-LookupList^[Y]
                else
                        Size := IndexRec.Length div 4 - LookupList^[Y];

                mulStream.Seek( Start + LookupList^[y]*4, soFromBeginning );

                X := 0;
                mulStream.Read( Buffer, Size*4 );
                for i := 0 to size-1 do begin
                        J := X + Buffer[i].Run;
                        while x < j do begin
                                if (x < Result.Width) and (y < Result.Height) and (x >= 0) and (y >= 0) then
                                        Result.Pixel[x,y] := Color15to32( Buffer[i].Value )
                                else
                                        showmessage( 'Buggy Pixel: ' + inttostr( x ) +','+ inttostr( y ) ); 
                                inc( x );
                        end;
                end;
                inc( y );
        end;

        FreeMem( LookupList, Hoehe*4 );
end;

procedure TGump.LoadGump( Id : Integer; FilePath : String );
var     Hoehe, Breite : Word;
        IndexRec : TIndexRecord;
        Bitmap : TBitmap;
        x, y, i : Integer;
        LookupList, Size : PIntegerArray;
        Color32, Color15 : Integer;
        CurrentLength, CurrentColor : Integer;
        New : Boolean;
        Buffer : Array[0..2048] of Record Value, Run : Word; end;
        Buf : Record Value, Run : Word; end;
        BufCounter : Integer;
        Stream : TMemoryStream;
begin
        Bitmap := TBitmap.Create;
        Bitmap.LoadFromFile( FilePath );

        Stream := TMemoryStream.Create;
        Stream.Seek( 0, soFromBeginning );

        Hoehe := Bitmap.Height;
        Breite := Bitmap.Width;

        GetMem( LookupList, Hoehe*4 );
        GetMem( Size, Hoehe*4 );

        CurrentColor := 0;
        CurrentLength := 0;
        y := 0;
        BufCounter := 0;
        New := true;
        while y < Hoehe do begin
                x := 0;
                while x < Breite do begin
                        Color32 := Bitmap.Canvas.Pixels[ x, y ];
                        Color15 := ((Color32 and $F80000) shr 19) or ((Color32 and $F800) shr 6) or ((Color32 and $F8) shl 7);
                        If Color15 = CurrentColor then begin
                                inc( CurrentLength );
                                New := false;
                        end
                        else if not New then begin
                                Buffer[ BufCounter ].Value := CurrentColor;
                                Buffer[ BufCounter ].Run := CurrentLength;
                                CurrentColor := Color15;
                                CurrentLength := 1;
                                inc( BufCounter );
                        end
                        else begin
                                CurrentLength := 1;
                                CurrentColor := Color15;
                                New := false;
                        end;

                        if x = Breite-1 then begin
                                CurrentColor := Color15;
                                Buffer[ BufCounter ].Value := CurrentColor;
                                Buffer[ BufCounter ].Run := CurrentLength;
                                CurrentLength := 0;
                                CurrentColor := 0;
                                inc( BufCounter );
                                New := true;
                        end;
                        inc( x );
                end;

                for i := 0 to BufCounter-1 do begin
                        Stream.Write( Buffer[ i ], 4 );
                end;

                Size^[ y ] := BufCounter;
                BufCounter := 0;
                inc( y );
        end;

        IndexRec.Length := Stream.Size + Hoehe*4;

        LookupList^[ Hoehe-1 ] := IndexRec.Length div 4 - Size^[ Hoehe-1 ];
        for i := 0 to Hoehe-2 do begin
                LookupList^[Hoehe-2-i] := LookupList^[Hoehe-1-i] - Size^[Hoehe-2-i];
        end;

        mulStream.Seek( 0, soFromEnd );
        IndexRec.Offset := mulStream.Position;

        mulStream.Write( LookupList^, Hoehe*4 );
        FreeMem( LookupList, Hoehe*4 );
        FreeMem( Size, Hoehe*4 );

        Stream.Seek( 0, soFromBeginning );
        for i := 0 to (Stream.Size div 4)-1 do begin
                Stream.Read( Buf, 4 );
                mulStream.Write( Buf, 4 );
        end;
        Stream.Free;

        IndexRec.Extra := ( Breite shl 16 ) + Hoehe;

        Encrypt( Id, IndexRec );
        idxStream.Seek( Id*12, soFromBeginning );
        idxStream.Write( IndexRec, sizeof( TIndexRecord ) );
        Bitmap.Free;
end;

procedure TGump.Delete( Id : Integer );
var     IndexRec : TIndexRecord;
begin
        IndexRec.Offset := -1;
        IndexRec.Length := -1;
        IndexRec.Extra := -1;

        Encrypt( Id, IndexRec );
        idxStream.Seek( Id*12, soFromBeginning );
        idxStream.Write( IndexRec, sizeof( TIndexRecord ) );
end;

procedure TGump.ReIndex( idxPath, mulPath : String );
var     Id, ListId, Count, RandCount, I : Integer;
        iStream, mStream : TFileStream;
        IndexRecord, OldIndexRecord : TIndexRecord;
        Liste : TList;
        B : Byte;
begin
        Randomize;

        if FileExists( idxPath ) then
                DeleteFile( idxPath );
        if FileExists( mulPath ) then
                DeleteFile( mulPath );

        iStream := TFileStream.Create( idxPath, fmCreate );
        mStream := TFileStream.Create( mulPath, fmCreate );
        iStream.Seek( 0, soFromBeginning );
        mStream.Seek( 0, soFromBeginning );

        Count := idxStream.Size div 12;

        IndexRecord.Offset := -1;
        IndexRecord.Length := -1;
        IndexRecord.Extra := -1;

        Liste := TList.Create;
        for Id := 0 to Count-1 do begin
                Liste.Add( Pointer( Id ) );
                iStream.Write( IndexRecord, 12 );
        end;

        GaugeForm.Activate;

        while Liste.Count > 0 do begin
                GaugeForm.SetBalken( Trunc( 100*(Count-Liste.Count)/Count ) );
                ListId := Random( Liste.Count );
                Id := Integer( Liste.Items[ ListId ] );
                Liste.Delete( ListId );

                idxStream.Seek( Id*12, soFromBeginning );
                idxStream.Read( OldIndexRecord, 12 );
                Decrypt( Id, OldIndexRecord );

                RandCount := 4 + Random( 12 );
                for I := 0 to RandCount-1 do begin
                        B := Random( 256 );
                        mStream.Write( B, 1 );
                end;

                iStream.Seek( Id*12, soFromBeginning );
                if (OldIndexRecord.Offset <> -1) and (OldIndexRecord.Length > 0) then begin
                        mulStream.Seek( OldIndexRecord.Offset, soFromBeginning );
                        IndexRecord.Offset := mStream.Position;
                        IndexRecord.Length := OldIndexRecord.Length;
                        IndexRecord.Extra := OldIndexRecord.Extra;
                        mStream.CopyFrom( mulStream, IndexRecord.Length );

                        Encrypt( Id, IndexRecord );
                        iStream.Write( IndexRecord, 12 );
                end
                else begin
                        Encrypt( Id, OldIndexRecord );
                        iStream.Write( OldIndexRecord, 12 );
                end;
        end;

        Liste.Free;
        iStream.Free;
        mStream.Free;
        GaugeForm.Deactivate;
end;

procedure TGump.Encrypt( Id : Integer; var IndexRecord : TIndexRecord );
begin
        if MainForm.cbME.Checked then begin
                if not MainForm.MulCrypt.EncryptIndexRecordGump( Id, IndexRecord ) then begin
                        MainForm.cbME.Checked := False;
                end;
        end;
end;

procedure TGump.Decrypt( Id : Integer; var IndexRecord : TIndexRecord );
begin
        if MainForm.cbME.Checked then begin
                if not MainForm.MulCrypt.DecryptIndexRecordGump( Id, IndexRecord ) then begin
                        MainForm.cbME.Checked := False;
                end;
        end;
end;

function TGump.GetGumpCount : Integer;
begin
        if not Loaded then begin
                Result := 0;
                exit;
        end;

        Result := idxStream.Size div 12;
end;

function TGump.GetGumpHeight( Id : Integer ) : Word;
var     IndexRec : TIndexRecord;
        Hoehe, Breite : Word;
begin
        if not Loaded then begin
                Result := 0;
                exit;
        end;

        idxStream.Seek( Id*12, soFromBeginning );
        idxStream.Read( IndexRec, 12 );
        Decrypt( Id, IndexRec );

        Breite := IndexRec.Extra shr 16;
        Hoehe := IndexRec.Extra and $FFFF;

        Result := Hoehe;
end;

function TGump.GetGumpWidth( Id : Integer ) : Word;
var     IndexRec : TIndexRecord;
        Hoehe, Breite : Word;
begin
        if not Loaded then begin
                Result := 0;
                exit;
        end;

        idxStream.Seek( Id*12, soFromBeginning );
        idxStream.Read( IndexRec, 12 );
        Decrypt( Id, IndexRec );

        Breite := IndexRec.Extra shr 16;
        Hoehe := IndexRec.Extra and $FFFF;

        Result := Breite;
end;

end.
