unit uTextures;

interface

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

type TTextures = class
private
        idxStream, mulStream: TStream;
        miStream, mmStream : TMemoryStream;
        fiStream, fmStream : TFileStream;
public
        loaded : Boolean;
        constructor Create;
        destructor Free;
        procedure Load( idxPath, mulPath : String );
        procedure Save( idxPath, mulPath : String );
        function Exists( Id : Integer ) : Boolean;
        function GetTex( Id : Integer ) : TBitmap32;
        function GetTex24( Id, ItemColor : Integer ) : TBitmap;
        procedure LoadTex( Id : Integer; FilePath : String );
        procedure Delete( Id : Integer );
        procedure ReIndex( idxPath, mulPath : String );
        function GetLength( Id : Integer ) : Integer;
        procedure Encrypt( Id : Integer; var IndexRecord : TIndexRecord );
        procedure Decrypt( Id : Integer; var IndexRecord : TIndexRecord );
        function GetCount : Integer;        
end;

var     Textures : TTextures;

implementation

uses    StrLib, uGaugeForm, uMulpatcher;

constructor TTextures.Create;
begin
        miStream := TMemoryStream.Create;
        mmStream := TMemoryStream.Create;
        
        loaded := false;
end;

destructor TTextures.Free;
begin
        miStream.Free;
        mmStream.Free;
        if MainForm.LowMemory then begin
                fiStream.Free;
                fmStream.Free;
        end;
end;

procedure TTextures.Load( idxPath, mulPath : String );
begin
        if not MainForm.LowMemory then begin
                miStream.LoadFromFile( idxPath );
                mmStream.LoadFromFile( mulPath );
                idxStream := miStream;
                mulStream := mmStream;
        end
        else begin
                fiStream := TFileStream.Create( idxPath, fmOpenReadWrite );
                fmStream := TFileStream.Create( mulPath, fmOpenReadWrite );
                idxStream := fiStream;
                mulStream := fmStream;
        end;
        loaded := true;
end;

procedure TTextures.Save( idxPath, mulPath : String );
begin
        if not MainForm.LowMemory then begin
                miStream.SaveToFile( idxPath );
                mmStream.SaveToFile( mulPath );
        end;
end;

function TTextures.Exists( Id : Integer ) : Boolean;
var     IndexRec : TIndexRecord;
begin
        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 TTextures.GetTex( Id : Integer ) : TBitmap32;
var     IndexRec : TIndexRecord;
        Hoehe, Breite : Word;
        x, y : Integer;
        Color : Word;
begin
        Result := TBitmap32.Create;

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

        mulStream.Seek( IndexRec.Offset, soFromBeginning );

        if IndexRec.Length = 64*64*2 then begin
                Hoehe := 64;
                Breite := 64;
        end
        else if IndexRec.Length = 256*256*2 then begin
                Hoehe := 256;
                Breite := 256;
        end
        else if IndexRec.Length = 512*512*2 then begin
                Hoehe := 512;
                Breite := 512;
        end
        else begin
                Hoehe := 128;
                Breite := 128;
        end;

        Result.SetSize( Breite, Hoehe );

        y := 0;
        while y < Hoehe do begin
                x := 0;
                while x < Breite do Begin
                        mulStream.Read( Color, 2 );
                        Result.Pixel[x,y] := Color15to32( Color );
                        inc( x );
                end;
                inc( y );
        end;
end;

function TTextures.GetTex24( Id, ItemColor : Integer ) : TBitmap;
var     IndexRec : TIndexRecord;
        Hoehe, Breite : Word;
        x, y, Farbe : Integer;
        Color : Word;
        Red, Index : Byte;
begin
        Result := TBitmap.Create;
        Result.PixelFormat := pf24Bit;

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

        mulStream.Seek( IndexRec.Offset, soFromBeginning );

        if IndexRec.Length = 64*64*2 then begin
                Hoehe := 64;
                Breite := 64;
        end
        else if IndexRec.Length = 256*256*2 then begin
                Hoehe := 256;
                Breite := 256;
        end
        else if IndexRec.Length = 512*512*2 then begin
                Hoehe := 512;
                Breite := 512;
        end
        else begin
                Hoehe := 128;
                Breite := 128;
        end;

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

        y := 0;
        while y < Hoehe do begin
                x := 0;
                while x < Breite do Begin
                        mulStream.Read( Color, 2 );
                        Farbe := Color15to32( Color );
                        if Farbe = 0 then Farbe := 1;
                        if ItemColor <> -1 then
                                Result.Canvas.Pixels[x,y] := WinColor( Farbe )
                        else begin
                                Red := RedComponent( Farbe );
                                Index := Red div 8;
                                if Index = 0 then Index := 1;                                
                                Result.Canvas.Pixels[x,y] := WinColor( Max( Color15to32( Hues.GetColor( $9a, Index ) ), 1 ) );
                        end;
                        inc( x );
                end;
                inc( y );
        end;
end;

procedure TTextures.LoadTex( Id : Integer; FilePath : String );
var     IndexRec : TIndexRecord;
        Hoehe, Breite : Word;
        x, y : Integer;
        Bitmap : TBitmap;
        Color32 : Integer;
        Color15 : Word;
begin
        Bitmap := TBitmap.Create;
        Bitmap.LoadFromFile( FilePath );
        
        mulStream.Seek( 0, soFromEnd );
        IndexRec.Offset := mulStream.Position;

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

        if not ( (( Breite = 64 ) and ( Hoehe = 64 )) or (( Breite = 128 ) and ( Hoehe = 128 )) or (( Breite = 256 ) and ( Hoehe = 256 )) or (( Breite = 512 ) and ( Hoehe = 512 ))  ) then begin
                Bitmap.Free;
                showmessage( 'Bitmap muss 64x64 oder 128x128 oder 256x256 oder 512x512 sein. ' );
                Exit;
        end
        else if not ( (( Breite = 64 ) and ( Hoehe = 64 )) or (( Breite = 128 ) and ( Hoehe = 128 )) ) then begin
                showmessage( 'Diese Grösse wird mit den meisten (inkl. aller Osi) Clients nicht funktioneren.' );
        end;

        for y := 0 to Hoehe-1 do begin
                for x := 0 to Breite-1 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);
                        mulStream.Write( Color15, 2 );
                end;
        end;

        IndexRec.Length := mulStream.Position - IndexRec.Offset;

        if Hoehe = 64 then
                IndexRec.Extra := 0
        else
                IndexRec.Extra := 1;

        Encrypt( Id, IndexRec );

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

procedure TTextures.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 TTextures.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;

function TTextures.GetLength( Id : Integer ) : Integer;
var     IndexRec : TIndexRecord;
begin
        idxStream.Seek( Id*12, soFromBeginning );
        idxStream.Read( IndexRec, sizeof( TIndexRecord ) );

        Decrypt( Id, IndexRec );

        if IndexRec.Length = 64*64*2 then
                Result := 64
        else if IndexRec.Length = 256*256*2 then
                Result := 256
        else if IndexRec.Length = 512*512*2 then
                Result := 512
        else
                Result := 128;
end;

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

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

function TTextures.GetCount : Integer;
begin
        if not Loaded then
                Result := 0
        else
                Result := idxStream.Size div 12;
end;

end.
