zlib compress/uncompress banks

Well, what I thought would be a simple job of writing a data packer is turning into a complete nightmare!

I am trying to compress/uncompress a bank. This code was posted a while ago:

Import Pub.ZLib

Function CompressBank:TBank( bank:TBank )
	Local size=bank.Size()
	Local out_size=size+size/10+32
	Local out:TBank=TBank.Create( out_size )
	compress out.Buf()+4,out_size,bank.Buf(),size
	out.PokeByte 0,size
	out.PokeByte 1,size Shr 8
	out.PokeByte 2,size Shr 16
	out.PokeByte 3,size Shr 24
	out.Resize out_size+4
	Return out
End Function

Function UncompressBank:TBank( bank:TBank )
	Local out_size
	out_size:|bank.PeekByte(0)
	out_size:|bank.PeekByte(1) Shl 8
	out_size:|bank.PeekByte(2) Shl 16
	out_size:|bank.PeekByte(3) Shl 24
	Local out:TBank=TBank.Create( out_size )
	uncompress out.Buf(),out_size,bank.Buf()+4,bank.Size()-4
	Return out
End Function

but it does not seem to compress, and the uncompress function errors. Has anyone actually got this (or something similar) working?

Try this module, it is a Packer I have written for my personal use. It supports a tree like directory, Passwords, Zip and a simple password based encryption system. Source is available.
a comfortable Gui interface unfortunatly not.

If you have questions or you need an example post it and I will send you an email with the example.

Link: http://www.blitzforum.de/upload/file.php?id=1256

Here's some old'n'crusty code...

Rem
	Compress() example
End Rem

Strict

Local SFile:String = RequestFile("Source File")
Local DFile:String = RequestFile("Destination PAK", "pak", True)

CompressFile(SFile, DFile)

SFile = RequestFile("Source PAK", "pak")
DFile = RequestFile("Destination File", "", True)

DeCompressFile(SFile, DFile)

End


Function CompressFile(SourceFileName:String, DestFileName:String)
	Local SourceBank:TBank, DestBank:TBank
	Local SourceFileStream:TStream, DestFileStream:TStream
	Local SourceFileSize:Int, DestBankSize:Int
	
	If ExtractExt(DestFileName).ToLower() <> "pak" Then DestFileName :+ ".pak"
	
	SourceFileSize = FileSize(SourceFileName)
	SourceBank = CreateBank(SourceFileSize)
	
	SourceFileStream = OpenStream(SourceFileName, True, False)
	If SourceFileStream = Null Then  RuntimeError "Couldn't open source file ~q" + SourceFileName + "~q" 
	
	ReadBank(SourceBank, SourceFileStream, 0, SourceFileSize)
	
	CloseStream SourceFileStream
	
	DestBankSize = Ceil(SourceFileSize * 1.001) + 12
	DestBank = CreateBank(DestBankSize)

	compress(DestBank.Buf(), DestBankSize, SourceBank.Buf(), SourceFileSize)

	'DestBank.Resize(DestBankSize)
	
	DestFileStream = WriteStream(DestFileName)
	If DestFileStream = Null Then  RuntimeError "Couldn't create destination file ~q" + DestFileName + "~q"
	
	WriteInt DestFileStream, SourceFileSize
	WriteBank(DestBank, DestFileStream, 0, DestBankSize)
	
	CloseStream DestFileStream
End Function

Function DeCompressFile(SourceFileName:String, DestFileName:String)
	Local SourceBank:TBank, DestBank:TBank
	Local SourceFileStream:TStream, DestFileStream:TStream
	Local SourceFileSize:Int, DestBankSize:Int
	
	If ExtractExt(SourceFileName).ToLower() <> "pak" Then RuntimeError "Source file is not a PAK file"
	
	SourceFileSize = FileSize(SourceFileName) - 4
	SourceBank = CreateBank(SourceFileSize)
	
	SourceFileStream = OpenStream(SourceFileName, True, False)
	If SourceFileStream = Null Then  RuntimeError "Couldn't open source file ~q" + SourceFileName + "~q" 
	
	DestBankSize = ReadInt(SourceFileStream)
	ReadBank(SourceBank, SourceFileStream, 0, SourceFileSize)
	
	CloseStream SourceFileStream

	DestBank = CreateBank(DestBankSize)

	uncompress(DestBank.Buf(), DestBankSize, SourceBank.Buf(), SourceFileSize)
	
	DestFileStream = WriteStream(DestFileName)
	If DestFileStream = Null Then  RuntimeError "Couldn't create destination file ~q" + DestFileName + "~q"
	
	WriteBank(DestBank, DestFileStream, 0, DestBankSize)
	
	CloseStream DestFileStream
End Function

...and it seems to still work too. Always a bonus!

Thank you both - I've managed to get my own simple version working:

Function compressBank:TBank(sourceBank:TBank, level = 9)
	Local destBankSize = Ceil(sourceBank.Size() * 1.001) + 12
	Local destBank:TBank = CreateBank(destBankSize)
	
	compress2(destBank.Buf(), destBankSize, sourceBank.Buf(), sourceBank.Size(), level)
	
	'resize bank to it's compressed size
	destBank.Resize(destBankSize)
	
	Return destBank
End Function


Function uncompressBank:TBank(sourceBank:TBank, destBankSize)
'destBankSize holds size of the uncompressed data saved previously
	Local destBank:TBank = CreateBank(destBankSize)
	
	uncompress(destBank.Buf(), destBankSize, sourceBank.Buf(), sourceBank.Size())
	
	Return destBank
End Function

Hey klepto2 - Your packer mod looks nice. Could I have an example or two to get started with (as you so kindly offered in your post above!) =D

Thank you!

Here we go it is a converted of the tiledrop.bmx in the sample folder of Blitzmax (BlitzmaxPath/samples/birdie/games/tiledrop)

Just save it within the same folder like the original bmx file.

Strict
Import klepto.klpacker

Local KLPack:TKLPack
'Creating the package if data.klp is not available

If FileType("Data.klp") = 0 Then 
	KLPack = CreatePackage("Data" , 9 , "tiledrop") ' Parameters: Packagename(without ending), CompressionRate,Password
	AddDirtoPack(KLPack , "media") ' Creating a Dir in the PAckage
	AddDirtoPack(KLPack , "media/test") ' Adding a second dir just as a test
	
	'Adding Files like You do with incbin
	AddFiletoPack(KLPACK , "media/back.png" , "media")
	AddFiletoPack(KLPACK , "media/blocks.png" , "media")
	AddFiletoPack(KLPACK , "media/part.png" , "media")
	AddFiletoPack(KLPACK , "media/pointer.png" , "media") 
	AddFiletoPack(KLPACK , "media/shine.png" , "media/test") ' Also just for testing an extra dir
	
	' At the end we save and build the package
	BuildPackage(KLPACK,"") 
Else
	'We load the package URL, and Password
	KLPack = LoadPackage("Data.klp" , "tiledrop")
	KLPAck.GetDirs() ' A small Helper Function to Display the File Hirarchy
EndIf	



Graphics 640 , 480

'Here we load the Files previously saved in the package

Global backIm:TImage = LoadImage(GetFile(KLPack,"media/back.png"))
AutoMidHandle 1
Global blocks:TImage = LoadAnimImage(GetFile(KLPack,"media/blocks.png"),32,32,0,16)
Global partImg:TImage = LoadImage(GetFile(KLPack,"media/part.png"))
Global mousePoint:TImage= LoadImage(GetFile(KLPack,"media/pointer.PNG"))
Global shine_img:TImage = LoadImage(GetFile(KLPack,"media/test/shine.png"))
AutoMidHandle 0
Global Map[8,14]
Global t1x,t1y,t2x,t2y
Global mouse_left_state
Global selection_done
Global rotation# = 0
Global Center_X#
Global Center_Y#
Global mt1,mt2
Global Tile_Rad#
Global THE_Axis
Global FLIPSPEED=8
Global Scn_Flash#=0
Global shine_pos#=0

HideMouse
While Not KeyDown(KEY_ESCAPE)
  Cls
  DrawLayout()
  If selection_done =0
    FillGrid()
  EndIf

  DrawGrid()

  If selection_done
    do_swap_tiles()
  Else
    UpdateSelection()
  EndIf

  SetBlend MASKBLEND
  DrawText mouse_left_state,0,0
  DrawText t1x+","+t1y,0,12
  DrawText t2x+","+t2y,0,23
  DrawImage mousePoint,MouseX(),MouseY()
  Flip
Wend

End
Function UpdateSelection()
  Local x=MouseX()-192
  Local y=MouseY()-24
  Local dx,dy

  If MouseDown(1)
    Select mouse_left_state
      Case 0
        If x>=0 And x<256
          If y>=0 And y<448
            'select tile1
            t1x=Floor(x/32.0)
            t1y=Floor(y/32.0)
          EndIf
        EndIf
        'get tile 1
        mouse_left_state=1
      Case 2
        If x>=0 And x<256
          If y>=0 And y<448
            'select tile1
            t2x=Floor(x/32.0)
            t2y=Floor(y/32.0)
          EndIf
        EndIf
        mouse_left_state=3
    EndSelect
  Else
    Select mouse_left_state
      Case 1
        mouse_left_state=2
      Case 3
        'check that only 1 tile away and not diag
        dx=Abs(t2x-t1x)
        dy=Abs(t2y-t1y)
        If dx=1 And dy=0
'          Switch(t1x,t1y,t2x,t2y)
          selection_done=1
        ElseIf dx=0 And dy=1
'          Switch(t1x,t1y,t2x,t2y)
          selection_done=1
        EndIf
          mouse_left_state=0
      Case 99
        mouse_left_state=0
    EndSelect
  EndIf

EndFunction

'add tiles to array at the top
Function FillGrid()
  Local x,y,tl,tlc
  For x=0 Until 8
    If map[x,0]=0
      map[x,0]=1+Rnd(1)*7'15
    EndIf
  Next
  'Fall
  For y=12 To 0 Step -1
    For x=0 Until 8
      If map[x,y]>0
        If map[x,y+1]=0
          map[x,y+1]=map[x,y]
          map[x,y]=0
        EndIf
      EndIf
    Next
  Next

  For y=0 Until 14
    For x=0 Until 8
      tl=map[x,y]
      If tl>0
        If Counttile(x,y,tl,0,tlc)
          KillTiles(x,y,tlc,0)
        ElseIf Counttile(x,y,tl,1,tlc)
          KillTiles(x,y,tlc,1)
        ElseIf Counttile(x,y,tl,2,tlc)
          KillTiles(x,y,tlc,2)
        ElseIf Counttile(x,y,tl,3,tlc)
          KillTiles(x,y,tlc,3)
        EndIf

      EndIf
    Next
  Next
EndFunction

Function KillTiles(x,y,c,dir)
  Local d
  For d=0 Until c
    Select dir
      Case 0
        map[x,y]=0
        y:-1
      Case 1
        map[x,y]=0
        x:+1
      Case 2
        map[x,y]=0
        y:+1
      Case 3
        map[x,y]=0
        x:-1
    EndSelect
  Next
EndFunction

Function CountTile(x,y,ty,dir, cn Var)
  cn = 0
  Select dir
    Case 0 ' Up
      While y>0
        If map[x,y]=ty
          cn:+1
        Else
          Return cn>2
        EndIf
        y=y-1
      Wend
      Return cn>2
    Case 1 ' Right
      While x<8
        If map[x,y]=ty
          cn:+1
        Else
          Return cn>2
        EndIf
        x:+1
      Wend
      Return cn>2
    Case 2 ' Down
      While y<14
        If map[x,y]=ty
          cn:+1
        Else
          Return cn>2
        EndIf
        y:+1
      Wend
      Return cn>2
    Case 3 ' Left
      While x>0
        If map[x,y]=ty
          cn:+1
        Else
          Return cn>2
        EndIf
        x:-1
      Wend
      Return cn>2
  EndSelect
  cn = 0
  Return 0
EndFunction

Function DrawGrid()
  SetColor 255,255,255
  Local x,y
  For y=0 Until 14
    For x=0 Until 8
      If selection_done
        If map[x,y]>0
          If (x=t1x And y=t1y) Or (x=t2x And y=t2y)
          Else
            SetBlend MASKBLEND
            DrawImage blocks,208+x*32,32+y*32,map[x,y]-1
          EndIf
        EndIf
      Else
        If map[x,y]>0
          DrawImage blocks,208+x*32,32+y*32,map[x,y]-1
        EndIf
      EndIf
    Next
  Next
  SetViewport 0,0,640,480
EndFunction

Function DrawLayout()
  Cls
  If Scn_Flash<0
    Scn_Flash:+0.2
  Else
    Scn_Flash=0
  EndIf
    SetBlend SOLIDBLEND
    SetColor 255,255,255
  TileImage backIm,0,0
  SetColor 128,128,128
  SetViewport 192,24,256,448
  Cls
  TileImage backIm,0,0
  If shine_pos#=0  SetViewport 0,0,640,480
EndFunction

Function CausesPop()
  Local x,y,tl,tlc
  For y=0 Until 14
    For x=0 Until 8
      tl=map[x,y]
      If tl>0
        If Counttile(x,y,tl,0,tlc)
          Return 1
        ElseIf Counttile(x,y,tl,1,tlc)
          Return 1
        ElseIf Counttile(x,y,tl,2,tlc)
          Return 1
        ElseIf Counttile(x,y,tl,3,tlc)
          Return 1
        EndIf
      EndIf
    Next
  Next
  Return 0
EndFunction

Function Switch(x0,y0,x1,y1)
  Local a
  a=map[x0,y0]
  map[x0,y0]=map[x1,y1]
  map[x1,y1]=a
  If CausesPop() Return 1
  a=map[x0,y0]
  map[x0,y0]=map[x1,y1]
  map[x1,y1]=a
  Return 0
EndFunction

Function Do_Swap_Tiles()
  Local x1,x2,y1,y2
  Local size1#,size2#
  Select selection_done
    Case 1
      'setup tile swap
      rotation=180
      selection_done = 2
      'calculate center
      x1 = 208+t1x*32
      x2 = 208+t2x*32
      y1 = 32+t1y*32
      y2 = 32+t2y*32
      Center_X = ((x2-x1)/2)+x1
      Center_Y = ((y2-y1)/2)+y1
      Tile_Rad = 16
      'check side
      If t1y=t2y
        If t1x>t2x
          mt1 = map[t2x,t2y]
          mt2 = map[t1x,t1y]
        Else
          mt1 = map[t1x,t1y]
          mt2 = map[t2x,t2y]
        EndIf
      Else
        If t1y>t2y
          mt1 = map[t2x,t2y]
          mt2 = map[t1x,t1y]
        Else
          mt1 = map[t1x,t1y]
          mt2 = map[t2x,t2y]
        EndIf
      EndIf

      THE_Axis = 1
      If t1y=t2y THE_Axis = 0
    Case 2
      If rotation<0
        If Switch(t1x,t1y,t2x,t2y)
          selection_done = 0
        Else
          selection_done = 3
        EndIf
      Else
        rotation:-FLIPSPEED
        size2# = 0.80+0.20*Sin(rotation)
        size1# = 0.80+0.20*Sin(-rotation)
        Select THE_Axis
          Case 0 'x
            SetScale size1,size1
            DrawImage blocks, Center_X+Tile_Rad*Cos(rotation), Center_Y, mt1-1
            SetScale size2,size2
            DrawImage blocks, Center_X-Tile_Rad*Cos(rotation), Center_Y, mt2-1
            SetScale 1,1
          Case 1 ' y
            SetScale size1,size1
            DrawImage blocks, Center_X, Center_Y+Tile_Rad*Cos(rotation), mt1-1
            SetScale size2,size2
            DrawImage blocks, Center_X, Center_Y-Tile_Rad*Cos(rotation), mt2-1
            SetScale 1,1
        EndSelect
      '  DrawImage blocks,192+t2x*32,24+t2y*32,mt2
      EndIf
    Case 3 '
      If rotation>=180
        selection_done = 0
      Else
        rotation:+FLIPSPEED
        size2# = 0.80+0.20*Sin(rotation)
        size1# = 0.80+0.20*Sin(-rotation)
        Select THE_Axis
          Case 0 'x
            SetScale size1,size1
            DrawImage blocks, Center_X+Tile_Rad*Cos(rotation), Center_Y, mt1-1
            SetScale size2,size2
            DrawImage blocks, Center_X-Tile_Rad*Cos(rotation), Center_Y, mt2-1
            SetScale 1,1
          Case 1 ' y
            SetScale size1,size1
            DrawImage blocks, Center_X, Center_Y+Tile_Rad*Cos(rotation), mt1-1
            SetScale size2,size2
            DrawImage blocks, Center_X, Center_Y-Tile_Rad*Cos(rotation), mt2-1
            SetScale 1,1
        EndSelect
      EndIf
  EndSelect

EndFunction

Thank you Klepto2!!

I have modified the Compression function to save the Packed data after compressing direct to the disk. The sourcebank is a bank that i created in the mainapplication as;

global mybank:tbank=createbank(4096)

Function compressBank:TBank(sourceBank:TBank, level = 9)
	Local destBankSize = Ceil(sourceBank.Size() * 1.001) + 12
	Local destBank:TBank = CreateBank(destBankSize)
	
	compress2(destBank.Buf(), destBankSize, sourceBank.Buf(), sourceBank.Size(), level)
	
	'resize bank to it's compressed size
	destBank.Resize(destBankSize)
	
	savebank (destBank, "Bank.pak" )
End Function


Function uncompressBank:TBank(sourceBank:TBank, destBankSize)
'destBankSize holds size of the uncompressed data saved previously
	Local destBank:TBank = CreateBank(destBankSize)
	
	uncompress(destBank.Buf(), destBankSize, sourceBank.Buf(), sourceBank.Size())
	
	Return destBank
End Function

I want now that i load the compressed bank from disk and uncompress it direct to my bank. how can i realize that.

i create a new bank like:

local banknew:tbank=loadbank("bank.pak")

uncompressBank (banknew, 4095)

i setup the uncompress funtion to this:

uncompress(myBankBank.Buf(), destBankSize, sourceBank.Buf(), sourceBank.Size())

but it does not work! Can someone help me.