[Fix]Porting code B3D To BlitzMax?

BlitzMax Forums/BlitzMax Programming/[Fix]Porting code B3D To BlitzMax?

Yue	(Posted 2016) [#1]

Hello, someone with experience and who wants to help us carry this code to BlitzMax , try the exporter but has not worked.

 

; PakFile Handling Routines 2.1
; Copyright Lee Page
; TeraBit Software 2000 - 2002

Type UnpackedFiles
	Field file$
End Type

Type ExpDir
	Field dir$
End Type

Dim pakfiles$(4000)			
Dim paklocate(4000)			
Dim PakSize(4000)			

Dim AddPack$(4000)
Dim AddPackSize(4000)
Dim AddPackOffset(4000)

Global AddPackCount
Global AddPackHeaderMask
Global AddPackKey
Global AddFileTrack
Global OutputDir$
Global LastPak$
Global PakBulkOverwrite

Global PackCount			;	Items in the pack file.
Global key					;	The Encrytion Key
Global Packname$			; 	The Default is DATA.PAK
Global exeoffset			;	For use when Data is packed into an .EXE
Global pakAPND$				; 	Sets up the Name to append to the start of the unpacked filenames

Global ChunkName$, Chunklen

; These are the Pak File Extraction Routines
;-----------------------------------------------------------------------

Function PakInit(myfile$,mykey,APND$,headermask)			; PackFile Initialisation

Local Exists
Local Headcount
Local pack
Local Retrieve
Local Offset
Local Block
Local Tem$
Local secbit
Local Hold
Local T
Local Fty
Local cnt
Local Filecnt

key = mykey	
pakAPND$=APND$
If FileType(myfile$)<>0 Then						; Check to see if the Archive Exists
Packname$=myfile$									; If so set up Global Pack Name
Else												; Otherwise
Packname$="Data.pak"								; Default to Data.Pak
EndIf												

If Upper$(Right$(Packname$,4))=".EXE" Or Upper$(Right$(Packname$,4))=".SCR" Then	; If the Archive is a .EXE File
Retrieve = ReadFile(Packname$)						; Open the Archive
SeekFile(Retrieve,FileSize(Packname$)-10)			; Find the Archive Data Section
exeoffset = ReadInt(Retrieve)-1						; Set Global Offset to Data Section
exeoffset=exeoffset - headermask     				; New 
CloseFile(Retrieve)									; Close Data Pack
EndIf		

pack = ReadFile(Packname$)							; Open Archive

SeekFile(pack,exeoffset)							; Seek to Data Section (0 if DATA.PAK)
Offset = ReadInt(pack)
													; Find Header Information
Offset = Offset Xor headermask         				; New

SeekFile(pack,(Offset-1)+exeoffset)					; Go to the Header

PackCount = ReadInt(pack)							; Read the number of items in the pack
Headcount=(FileSize(Packname$)-FilePos(pack))+4



Block = CreateBank(Headcount)
ReadBytes Block,pack,0,Headcount-4
If key<>0 Then
For Filecnt=1 To Headcount-4 Step 4
Hold=PeekInt(Block,Filecnt-1)
Hold = Hold Xor key
PokeInt Block,Filecnt-1,Hold
Next 
EndIf
Tem$ = ""
secbit=0
cnt = 1

For T=0 To Headcount-5
If PeekByte(Block,T)=13 Then 

	If Fty = 0 Then 
	pakfiles$(cnt)=Upper$(Tem$)
	EndIf

	If Fty = 1 Then 
		paklocate(cnt)=Str(Tem$)
		paklocate(cnt)=paklocate(cnt)+exeoffset
	EndIf

	If Fty = 2 Then 
		PakSize(cnt)=Str(Tem$)
		cnt=cnt+1
	EndIf
Fty=Fty+1
If Fty=3 Then Fty=0
Tem$=""
;t=t+1
Else
Tem$=Tem$ + Chr$(PeekByte(Block,T))
EndIf
Next 

	
FreeBank Block										; Record this info in a Global Array
CloseFile (pack)									; for use by Other Functions
End Function										; Then Close the Archive

;-----------------------------------------------------------------------

Function pak$(pkf$)									; Get Filename to retrieve

If Left$(pkf$,1)="\" Or Left$(pkf$,1)="/" Then pkf$=Right$(pkf$,Len(pkf$)-1)

Local IsoName
Local cnt
Local item
Local Pack
Local Output
Local Block
Local filecnt
Local Hold
Local Ext$
Local Ex2$
Local outf$

If Instr(pkf$,"\")=0 And Instr(pkf$,"/")=0 Then 
IsoName = True
Else
CreateDirTree IsoPath(pkf$)
EndIf

For cnt=1 To PackCount								; Count through Archive list
	If IsoName = True Then
		If isolatename(Upper$(pakfiles$(cnt)))=Upper$(pkf$) Then		; If it exists in Archive
			item = cnt									; then set item to it's index
			Exit										; and break out of the loop
		EndIf
	Else
		If Upper$(pakfiles$(cnt))=Upper$(pkf$) Then		; If it exists in Archive
			item = cnt									; then set item to it's index
			Exit										; and break out of the loop
		EndIf
	EndIf
Next
If item = 0 Then 									; If no items were found
	Return pkf$										; Exit the subroutine
EndIf

LastPak$ = IsoPath(pkf$)+pakAPND$+isolatename(pkf$)
For lpk.unpackedfiles = Each UnpackedFiles
If Upper$(lpk\file$) = Upper$(LastPak$) Then exists = 1 : Exit
Next

If exists=0 Then
	lpk.UnpackedFiles = New UnpackedFiles 
	lpk\file$ = LastPak$
EndIf

If FileType(IsoPath(pkf$)+pakAPND$+isolatename(pkf$))=0 Or PakBulkOverwrite = True Then ; Does the File Already Exist?
	Pack = ReadFile(Packname$)							; Open the Archive
	SeekFile(Pack,paklocate(item))						; Locate the Data in the store
	Output = WriteFile(IsoPath(pkf$)+pakAPND$+isolatename(pkf$))		; Open the output File
	Block = CreateBank(PakSize(item)+4)
	ReadBytes Block,Pack,0,PakSize(item)
	If key<>0 Then
	For filecnt=1 To PakSize(item) Step 4
	Hold=PeekInt(Block,filecnt-1)
	Hold = Hold Xor key
	PokeInt Block,filecnt-1,Hold
	Next 
	EndIf
	WriteBytes Block,Output,0,PakSize(item)
	CloseFile(Output)
	CloseFile(Pack)	
EndIf
	
Ext$ = Upper$(Right$(pkf$,4))
Ex2$ = Upper$(Right$(pkf$,2))

FreeBank Block

If Ext$=".3DS" Or Ex2$=".X" Or Ext$="MD2" Then texcheck(IsoPath(pkf$)+pakAPND$+isolatename(pkf$))
If Ext$=".B3D" Then ParseB3D(IsoPath(pkf$)+pakAPND$+isolatename(pkf$))
Return IsoPath(pkf$)+pakAPND$+isolatename(pkf$)								; Return the Filename
End Function

;-----------------------------------------------------------------------

Function texpak$(pkf$)									; Get Filename to retrieve
DebugLog pkf$
If Left$(pkf$,1)="\" Or Left$(pkf$,1)="/" Then pkf$=Right$(pkf$,Len(pkf$)-1)

Local cnt
Local item
Local Pack
Local Output
Local Block
Local filecnt
Local Hold
Local IsoName

If Instr(pkf$,"\")=0 And Instr(pkf$,"/")=0 Then 
IsoName = True
Else
CreateDirTree IsoPath(pkf$)
EndIf

For cnt=1 To PackCount								; Count through Archive list
	If IsoName = True Then
		If isolatename(Upper$(pakfiles$(cnt)))=Upper$(pkf$) Then		; If it exists in Archive
			item = cnt									; then set item to it's index
			Exit										; and break out of the loop
		EndIf
	Else
		If Upper$(pakfiles$(cnt))=Upper$(pkf$) Then		; If it exists in Archive
			item = cnt									; then set item to it's index
			Exit										; and break out of the loop
		EndIf
	EndIf
Next
If item = 0 Then 									; If no items were found
	Return pkf$										; Exit the subroutine
EndIf

outf$ = Upper$(IsoPath(pkf$)+isolatename(pkf$))
For lpk.unpackedfiles = Each UnpackedFiles
If Upper$(lpk\file$) = outf$ Then exists = 1 : Exit
Next

If exists=0 Then
	lpk.UnpackedFiles = New UnpackedFiles 
	lpk\file$ = IsoPath(pkf$)+isolatename(pkf$)
EndIf

If FileType(outf$)=0 Or PakBulkOverwrite = True Then
	Pack = ReadFile(Packname$)							; Open the Archive
	SeekFile(Pack,paklocate(item))						; Locate the Data in the store
	Output = WriteFile(IsoPath(pkf$)+isolatename(pkf$))	; Open the output File
	Block = CreateBank(PakSize(item)+4)
	
	ReadBytes Block,Pack,0,PakSize(item)
	If key<>0 Then
	For filecnt=1 To PakSize(item) Step 4
	Hold=PeekInt(Block,filecnt-1)
	Hold = Hold Xor key
	PokeInt Block,filecnt-1,Hold
	Next 
	EndIf
	WriteBytes Block,Output,0,PakSize(item)
	
	CloseFile(Pack)										; Close Both files
	CloseFile(Output)
	FreeBank Block
EndIf

Return IsoPath(pkf$)+isolatename(pkf$)				; Return the Filename
End Function


;-----------------------------------------------------------------------

Function PakClean()									; Clean Up function to remove
Local cnt.UnpackedFiles

For cnt.UnpackedFiles = Each UnpackedFiles
	DeleteFile cnt\file$								; Deletes all files unpacked so far
	Delete cnt
Next												; That are contained in the Archive
End Function										; Keep Backups elsewhere and copy them in.

;-----------------------------------------------------------------------

Function texcheck(modname$)
Local file
Local size
Local png
Local jpg
Local bmp
Local tga

Local pnga
Local jpga
Local bmpa
Local tgaa

Local Bank
Local t
Local ser
Local m
Local tex$
Local k
Local ltp$

file = ReadFile(modname$)

If file = 0 Then Return

putit$ = justPath(modname$)
putit$ = Right$(putit$,Len(putit$)-Len(OutputDir$))

size = FileSize(modname$)

Bank = CreateBank(size+4)

png = svl(".png")
jpg = svl(".jpg")
bmp = svl(".bmp")
tga = svl(".tga")

pnga = svl(".PNG")
jpga = svl(".JPG")
bmpa = svl(".BMP")
tgaa = svl(".TGA")

ReadBytes Bank,file,0,size

CloseFile file
ltp$=""
For t = 1 To size
	ser = PeekInt(Bank,t)
		If ser = png Or ser = jpg Or ser = bmp Or ser = pnga Or ser = jpga Or ser = bmpa Or ser = tga Or ser = tgaa Then
			m = t
			While PeekByte(Bank,m)<>0 And m>0 And PeekByte(Bank,m)<>34 And PeekByte(Bank,m)>31 And PeekByte(Bank,m)<127 
				m=m-1
			Wend
			tex$ = ""
			For k=m+1 To t+3
				tex$=tex$+Chr$(PeekByte(Bank,k))
			Next
			tex$=isolatename(tex$)
			If ltp$<>(putit$+tex$) Then 
				texpak(putit$+tex$)
				ltp$ = putit$+tex$
			EndIf
		EndIf
Next

FreeBank Bank
End Function

Function svl(ser$)
Local try
Local retval

try = CreateBank(4)

PokeByte try,0,Asc(Mid$(ser$,1,1))
PokeByte try,1,Asc(Mid$(ser$,2,1))
PokeByte try,2,Asc(Mid$(ser$,3,1))
PokeByte try,3,Asc(Mid$(ser$,4,1))

retval = PeekInt(try,0)

FreeBank try

Return retval

End Function

Function CreatePakFile(destfile$, APKey, Head)
Local Crap
SeedRnd MilliSecs()

AddFileTrack = WriteFile(destfile$)
AddPackCount=0
AddPackHeaderMask = Head
AddPackKey = APKey

WriteInt AddFileTrack, 0
For Crap = 1 To Rand(500)
	WriteByte AddFileTrack,Rand(254)
Next
End Function

Function AddtoPak(myfile$)
Local ScratchBank
Local FullSize
Local FileAxis
Local Crypt
Local Hold

AddPackCount = AddPackCount + 1
AddPack$(AddPackCount) = myfile$ ; Isolatename$(MyFile$)
AddPackSize(AddPackCount) = FileSize(myfile$)
AddPackOffset(AddPackCount) = FilePos(AddFileTrack)

FullSize = FileSize(myfile$)
ScratchBank = CreateBank(FullSize + 8)
FileAxis = ReadFile(myfile$)

ReadBytes ScratchBank,FileAxis,0,FullSize

If AddPackKey<>0 Then
	For Crypt = 0 To FullSize+4 Step 4
		Hold=PeekInt(ScratchBank,Crypt)
		Hold = Hold Xor AddPackKey
		PokeInt ScratchBank,Crypt,Hold
	Next 
EndIf
WriteBytes ScratchBank,AddFileTrack,0,FullSize

FreeBank ScratchBank
CloseFile FileAxis

End Function

Function CloseCreatedPak()
Local N$=""
Local S$=""
Local O$=""
Local Full$=""
Local Cnt = 0
Local ScratchBank
Local Crypt
Local Hold
Local Crap

For Cnt = 1 To AddPackCount

N$ = AddPack$(Cnt)
S$ = AddPackSize(Cnt)
O$ = AddPackOffset(Cnt)

Full$ = Full$ + N$ + Chr$(13)
Full$ = Full$ + O$ + Chr$(13)
Full$ = Full$ + S$ + Chr$(13)

Next

ScratchBank = CreateBank(Len(Full$)+4)

For Cnt = 1 To Len(Full$)
PokeByte ScratchBank, Cnt-1, Asc(Mid$(Full$,Cnt,1))
Next

If AddPackKey<>0 Then
	For Crypt = 0 To Len(Full$) Step 4
		Hold=PeekInt(ScratchBank,Crypt)
		Hold = Hold Xor AddPackKey
		PokeInt ScratchBank,Crypt,Hold
	Next 
EndIf

Hold = FilePos(AddFileTrack)+1

WriteInt AddFileTrack, AddPackCount

WriteBytes ScratchBank, AddFileTrack,0,Len(Full$)

FreeBank ScratchBank

SeedRnd MilliSecs()

For Crap = 1 To Rand(500)
	WriteByte AddFileTrack,Rand(255)
Next

SeekFile AddFileTrack, 0

Hold = Hold Xor AddPackHeaderMask

WriteInt AddFileTrack, Hold

CloseFile AddFileTrack
End Function

Function AppendToExe(myexefile$, myPakName$)
Local TempAxis
Local TempPax
Local EXELen
Local PakLen
Local ScratchBank

PakLen = FileSize(myPakName$)
EXELen = FileSize(myexefile$)
TempAxis = OpenFile(myexefile$)
TempPax = OpenFile(myPakName$)

ScratchBank = CreateBank(PakLen + 4)

ReadBytes ScratchBank,TempPax,0,PakLen

SeekFile TempAxis,EXELen

WriteBytes ScratchBank, TempAxis, 0, PakLen
WriteInt TempAxis, (EXELen + AddPackHeaderMask + 1)
WriteByte TempAxis,Asc("D") : WriteByte TempAxis,Asc("A") : WriteByte TempAxis,Asc("T") : WriteByte TempAxis,Asc("P") : WriteByte TempAxis,Asc("A") : WriteByte TempAxis,Asc("K")

CloseFile TempAxis
CloseFile TempPax

FreeBank ScratchBank

End Function

Function isolatename$(wha$)
    For t=Len(wha$) To 1 Step -1
        If Mid$(wha$,t,1)="\" Or Mid$(wha$,t,1)="/" Then
            Return Right$(wha$,Len(wha$)-t)
        EndIf
    Next
    Return wha$
End Function

Function IsoPath$(wha$)
    For t=Len(wha$) To 1 Step -1
        If Mid$(wha$,t,1)="\" Or Mid$(wha$,t,1)="/" Then
            Return OutputDir + Left$(wha$,t)
        EndIf
    Next
    Return OutputDir
End Function

Function justPath$(wha$)
    For t=Len(wha$) To 1 Step -1
        If Mid$(wha$,t,1)="\" Or Mid$(wha$,t,1)="/" Then
            Return Left$(wha$,t)
        EndIf
    Next
    Return ""
End Function

Function PakOutputDir(myDir$)
If Len(myDir$)<3 Then 
	myDir$=""
	Return
EndIf
If Right$(myDir$,1)<>"\" Or Right$(myDir$,1)<>"/" Then myDir$=myDir$+"\"
OutputDir$ = myDir$
CreateDirTree myDir$
End Function

Function DLPak()
Local t.UnpackedFiles

For t.UnpackedFiles = Each UnpackedFiles
If Upper$(t\file$)=Upper$(LastPak$) Then
	DeleteFile LastPak$
	Delete t
EndIf
Next
End Function

Function CreateDirTree(mydir$)
Local t
Local exists
Local nux$

mydir$=mydir$+"\"
If Mid$(mydir$,2,1)=":" Then t = 4 Else t = 1
Repeat 
	exists = 0
	If Mid$(mydir$,t,1)="\" Or Mid$(mydir$,t,1)="/" Then
	
	For mug.expdir = Each ExpDir
		If Upper$(mug\dir$) = Upper$(Left$(mydir$,t-1)) Then exists = 1 : Exit
	Next

	If exists=0 Then
		nux$=Left$(mydir$,t-1)
		If Right$(nux$,1)="\" Or Right$(nux$,1)="/" Then nux$=Left$(nux$,Len(nux$)-1)
		CreateDir nux$
		mug.expdir = New ExpDir
		mug\dir$ = Upper$(nux$) 
	EndIf
	EndIf
	t=t+1
Until t=Len(mydir$)
End Function

Function ParseB3D(B3DFile$)
If Upper$(Right$(B3DFile$,4))<>".B3D" Then Return
Local BHand, tind, texf, texb
Local CSize, Fsize, Entries
Local Putit$
Putit$ = justPath(B3DFile$)
Putit$ = Right$(Putit$,Len(Putit$)-Len(OutputDir$))

BHand = ReadFile(B3DFile$)
If BHand = 0 Then Return
Fsize = FileSize(B3DFile$)
ReadChunk(BHand)
ReadInt(BHand)
While FilePos(BHand)<Fsize
ReadChunk(BHand)
mypos = FilePos(BHand)
Select ChunkName$
Case "TEXS"
	While FilePos(BHand)<(mypos+Chunklen)
	texpak(Putit$+isolatename$(StringRead$(BHand)))
	ReadInt(BHand)
	ReadInt(BHand)
	ReadFloat(BHand)
	ReadFloat(BHand)
	ReadFloat(BHand)
	ReadFloat(BHand)
	ReadFloat(BHand)
	tind = tind +1
	Wend
	SeekFile BHand,mypos+Chunklen
Default 

SeekFile BHand,mypos+Chunklen
End Select
Wend
CloseFile BHand
End Function

Function ReadChunk(Strm)
Local chunk$
chunk$ = ""
chunk$=Chr$(ReadByte(Strm))
chunk$=chunk$ + Chr$(ReadByte(Strm))
chunk$=chunk$ + Chr$(ReadByte(Strm))
chunk$=chunk$ + Chr$(ReadByte(Strm))
ChunkName$=Upper$(chunk$)
Chunklen = ReadInt(Strm)
End Function

Function StringRead$(Strm)
	Local Gb
	Local RT$
	
	Repeat
		Gb=ReadByte(Strm)
		
		If Gb<>0 Then RT$=RT$+Chr$(Gb)
		
	Until Gb=0
	Return RT$
End Function

RustyKristi

(Posted 2016) [#2]

Here's a compiled successfully version and I created a new thread with that project title to make it more specific. It just doesn't work (crashes) but it builds successfully.

http://www.blitzbasic.com/Community/posts.php?topic=106376

I disabled the password in PakMaker to make it simple. The contents of the "DATA.PAK" pakfile is just the camel.b3d in openb3d/b3d sample.

Maybe someone can pick it up and check out some incompatibilities presented here.

I'm guessing the peek and poke stuff but still I'm not that yet familiar with advanced b3d methods.

Included are converted sources with some slight modifications to get it to build, the terapack packer program, camel.b3d and data.pak file.

Yue	(Posted 2016) [#3]

=)

"Hi John "Yue",

Thanks for getting in touch. Sadly I don't have much spare time these days :)!

Fortunately I ported the TeraPack to blitzmax a while back. Should still work, I've uploaded the files you need (the packer needs .NET), just use the stream identifier pak::

Download here: https://s3.amazonaws.com/EFNL/Packmaker.zip

Regards,

Lee Page
TeraBit Software"

RustyKristi

(Posted 2016) [#4]

That's great. I did test it in minib3d and it works great. With OpenB3D it has loading issues, maybe it is more C++ oriented than mini.

Yue	(Posted 2016) [#5]

To me it does not work , not if you do not use tell me if this correct ?.

Import  xorsteam.xors3d 
Include "Tipos/TGraphics3D.bmx"
Include "Tipos/TCamara.bmx"
Include "Tipos/TCubo.bmx"
 


Global PakStreams:PakStream = New PakStream
Global PakGlobals:TPakGlobal = New TPakGlobal

Include "Includes/TeraPak.bmx"
PakInit("DATA.PAK", $3F97DA40, $72D3B8C2)


ConfigEngine()

' Objetos.
'----------------
oG3D:TGraphics3D = TGraphics3D.Init()
xAppTitle ( nombreAPP:String )	

oCamara:TCamara = TCamara.Init()
xCameraClsColor ( oCamara.camara, 255,133,74,0 )

oCubo:TCubo = TCubo.Init()
xPositionEntity oCubo.cubo:Int, 0, 0, 10
xCreateLight()

Robot = xLoadMesh("pak::Robot.b3d")

Print Robot

While Not xKeyDown(xKEY_ESCAPE:Int)

   xTurnEntity(robot:Int,1,1,1)
   xUpdateWorld()
   xRenderWorld()
   InfoDebug()
   xFlip()
   
   If (xKeyDown(xKEY_UP:Int)) End 

  
Wend
' Liberando memoria.
'----------------------

oCamara.DeInit()
oCubo.DeInit()

oG3D.DeInit()
xDeInit()


'xFreeEntity ( cubo:Int)
'xFlushKeys()

RustyKristi

(Posted 2016) [#6]

With minib3d, this works with a few modifications but fails with OpenB3d and I don't know about Xors3d because I don't have it.

I still have problems as well as I'm working on OpenB3D and not minib3d.

Yue	(Posted 2016) [#7]

"pak::Music\Fireworks.wav"

not understand this, no where it defines " pak ::. nor how it works .... you can read the package, but the model is not stored in the variable.

RustyKristi

(Posted 2016) [#8]

The new Packmaker that Lee provided which you have shared, supports directory structures. You can see the tool now with the "+" icon.

That's why in that example "Music/Firework.wav", it should work.

Yue	(Posted 2016) [#9]

xPackFile* xMountPackFile  ( const char *  path,  
  const char *  mountpoint = "",  
  const char *  password = ""  
 )   

Mounts a zip file as a part of the file system and returns its handle. 

Use a zip file as a pack of your resources. Use of packs allows to compress the resources and to encrypt them with a password. Once mounted pack file becomes visible for the engine as a part of the file system. The second parameter is a mount point which is the location in the file system structure where a mounted pack file appears.

When you load some media, the engine searches that media in the mounted pack files first. For instance, the pack was mounted by using following

xMountPackFile("textures.zip", "textures\", "super_password");

Since now a pack file "textures.zip" is seen as a "textures\" directory.

If you load some texture by using

xLoadTexture("textures\something.dds");

the engine will try to load a texture "something.dds" from the pack mounted before since its mount point is "textures\". If there isn't such texture in the pack, the engine will try to load it from the disk using the path "textures\something.dds".

Such system allows you to develop and release your applications with ease. During development use loading from the disk. Before release pack your media and mount the packs using proper mount points.

Note:
: You can only read from packs (i.e. xReadFile(), xFileType() and xFileSize(), etc) You can't create, delete or change files in the packs. 
Parameters:
path A path to the pack file.  
mountpoint Mount point of the pack file.  
password A password of the pack file

Xoros3D for blitzmax support pack zip resource...

Yue	(Posted 2016) [#10]

Fixed to save a mesh BlitzMax in a resource file encryption, the secret is to change the name d ela mesh, for example if the mesh is called Robot.b3d, the name would robot.jpg, and ready to function very well.