Bass23

Blitz3D Forums/Blitz3D Userlibs/Bass23

The last off. version from modinfo.
This is compatible to BBS 1.6.1...so only replace it.

NEW COMMANDS:

Global MOD_Amiga = 0 ( If 1, returns only first 3 octaves)
MOD_GetRSample$(pattern%,row%,channel%) ; returns a $ Sample from 01 to 31
MOD_GetRFx$(pattern%,row%,channel%); retunrs a $ (ex .F06)

; 1.5 = added Function MOD_GetRSample$(pattern%,row%,channel%)
; 1.4 = added Function MOD_GetRFx$(pattern%,row%,channel%)
; 1.3 = added AMIGA mode
; 1.2 = fixed "last pattern" bug
; 1.1 = fixed "createbank" bug"



;-------------------------------------------------------------------------------------------------------------
; modinfo.bb by Abrexxes 2008 Version *Pex*
;
; Note :
; You can use this with bass/bassmod (for realtime stuff) or without !
; Read "Modinfo\modinfo.txt & functions.txt" for more informations.
;
; Important : At the moment only *.mod files supported !!!
; -------------------------------------------------------------------------------------------------------------
; 1.5 = added Function MOD_GetRSample$(pattern%,row%,channel%) 
; 1.4 = added Function MOD_GetRFx$(pattern%,row%,channel%)
; 1.3 = added AMIGA mode 
; 1.2 = fixed "last pattern" bug
; 1.1 = fixed "createbank" bug"
; ---- Globals ---------------------------------------------------------------------------------------------- 
Global MOD_Amiga = 0
Global MOD_Name$ = "" 
Global MOD_Orders% = 0
Global MOD_Tracker$ = "" 
Global MOD_ActiveChannels% = 0 
Global MOD_Id$ = "" 
Global MOD_Patterns% = 0
; ---- DIMs ------------------------------------------------------------------------------------------------
Dim MOD_SampleName$ (0)
Dim MOD_SampleAttrib% (0,0)
Dim MOD_OrderList% (0)
Dim MOD_Pat_Note$ (0,0)
Dim MOD_Pat_Sample% (0,0)
Dim MOD_Pat_Fx% (0,0)
Dim MOD_Pat_RFx$ (0,0)
Dim MOD_Pat_RSample$ (0,0)
; ---- Functions ------------------------------------------------------------------------------------------
Function MOD_GetName$()
	Return MOD_Name
End Function

Function MOD_GetOrders%()
	Return MOD_Orders
End Function

Function MOD_GetTracker$()
	Return MOD_Tracker
End Function

Function MOD_GetActiveChannels%()
	Return MOD_ActiveChannels
End Function 

Function MOD_GetId$()
	Return MOD_Id
End Function

Function MOD_GetPatterns$() 
	Return MOD_Patterns
End Function

Function MOD_GetActivePattern% (order%) 
	If order <0 Or order >(MOD_Orders-1) Then Return 0
	Return MOD_OrderList (order)
End Function

Function MOD_GetSampleName$(sample%)
	If sample <1 Or sample >31 Then Return "Not a valid sample number (1-31)"
	Return MOD_SampleName(sample-1)
End Function

Function MOD_GetSampleLenght%(sample%)
	If sample <1 Or sample >31 Then Return 0
	Return MOD_SampleAttrib(sample-1,0)
End Function

Function MOD_GetSampleFineTune%(sample%)
	If sample <1 Or sample >31 Then Return 0
	Return MOD_SampleAttrib(sample-1,1)
End Function

Function MOD_GetSampleVolume%(sample%)
	If sample <1 Or sample >31 Then Return 0
	Return MOD_SampleAttrib(sample-1,2)
End Function

Function MOD_GetSampleLoopStart%(sample%)
	If sample <1 Or sample >31 Then Return 0
	Return MOD_SampleAttrib(sample-1,3)
End Function

Function MOD_GetSampleLoopEnd%(sample%)
	If sample <1 Or sample >31 Then Return 0
	Return MOD_SampleAttrib(sample-1,4)
End Function

Function MOD_GetSample%(pattern%,row%,channel%) 
	Local x%, y%
		x = (pattern*64) + (row)
		y = channel-1
	Return MOD_Pat_Sample (x,y)
End Function 

Function MOD_GetRSample$(pattern%,row%,channel%) 
	Local x%, y%
		x = (pattern*64) + (row)
		y = channel-1
	Return MOD_Pat_RSample (x,y)
End Function 

Function MOD_GetNote$(pattern%,row%,channel%)
	Local x%, y%
		x = (pattern*64) + (row)
		y = channel-1
	Return MOD_Pat_Note (x,y)
End Function 

Function MOD_GetFx%(pattern%,row%,channel%)
	Local x%, y%
		x = (pattern*64) + (row)
		y = channel-1
Return MOD_Pat_Fx (x,y)
End Function 

Function MOD_GetRFx$(pattern%,row%,channel%)
	Local x%, y%
		x = (pattern*64) + (row)
		y = channel-1
Return MOD_Pat_RFx (x,y)
End Function

; ---- Loader & Reset----------------------------------------------------------------------------------
Function MOD_LoadData%(name$)
MOD_Reset()	
Local temp%, i%, n%, m%, offset%,temphex$,tempcut$
Local bin1$, bin2$, bin3$, bin4$, tempbin$
Local tempmod = ReadFile (name)

SeekFile (tempmod,1080) ; read tracker ID
For i = 1 To 4
		temp = ReadByte (tempmod)
			MOD_Id = MOD_Id + Chr$(temp)
Next

Select MOD_Id ; get tracker info & active channels
Case "M.K." : MOD_Tracker = "Protracker (Amiga) 4 channels" : MOD_ActiveChannels = 4
Case "M!K!" : MOD_Tracker = "Protracker (Amiga) 4 channels" : MOD_ActiveChannels = 4
Case "FLT4" : MOD_Tracker = "Startracker (Amiga) 4 channels" : MOD_ActiveChannels = 4
Case "FLT8" : MOD_Tracker = "Startracker (Amiga) 8 channels" : MOD_ActiveChannels = 8
Case "2CHN" : MOD_Tracker = "Fasttracker (PC) 2 channels" : MOD_ActiveChannels = 2
Case "4CHN" : MOD_Tracker = "Fasttracker (PC) 4 channels" : MOD_ActiveChannels = 4
Case "6CHN" : MOD_Tracker = "Fasttracker (PC) 6 channels" : MOD_ActiveChannels = 6
Case "8CHN" : MOD_Tracker = "Fasttracker (PC) 8 channels" : MOD_ActiveChannels = 8
Case "10CH" : MOD_Tracker = "Fasttracker (PC) 10 channels" : MOD_ActiveChannels = 10
Case "12CH" : MOD_Tracker = "Fasttracker (PC) 12 channels" : MOD_ActiveChannels = 12
Case "14CH" : MOD_Tracker = "Fasttracker (PC) 14 channels" : MOD_ActiveChannels = 14
Case "16CH" : MOD_Tracker = "Fasttracker (PC) 16 channels" : MOD_ActiveChannels = 16
Case "18CH" : MOD_Tracker = "Fasttracker (PC) 18 channels" : MOD_ActiveChannels = 18
Case "20CH" : MOD_Tracker = "Fasttracker (PC) 20 channels" : MOD_ActiveChannels = 20
Case "22CH" : MOD_Tracker = "Fasttracker (PC) 22 channels" : MOD_ActiveChannels = 22
Case "24CH" : MOD_Tracker = "Fasttracker (PC) 24 channels" : MOD_ActiveChannels = 24
Case "26CH" : MOD_Tracker = "Fasttracker (PC) 26 channels" : MOD_ActiveChannels = 26
Case "28CH" : MOD_Tracker = "Fasttracker (PC) 28 channels" : MOD_ActiveChannels = 28
Case "30CH" : MOD_Tracker = "Fasttracker (PC) 30 channels" : MOD_ActiveChannels = 30
Case "32CH" : MOD_Tracker = "Fasttracker (PC) 32 channels" : MOD_ActiveChannels = 32
Case "TDZ1" : MOD_Tracker = "TakeTracker (PC) 1 channel" : MOD_ActiveChannels = 1
Case "TDZ2" : MOD_Tracker = "TakeTracker (PC) 2 channels" : MOD_ActiveChannels = 2
Case "TDZ3" : MOD_Tracker = "TakeTracker (PC) 3 channels" : MOD_ActiveChannels = 3
Case "5CHN" : MOD_Tracker = "TakeTracker (PC) 5 channels" : MOD_ActiveChannels = 5
Case "7CHN" : MOD_Tracker = "TakeTracker (PC) 7 channels" : MOD_ActiveChannels = 7
Case "9CHN" : MOD_Tracker = "TakeTracker (PC) 9 channels" : MOD_ActiveChannels = 9
Case "11CH" : MOD_Tracker = "TakeTracker (PC) 11 channels" : MOD_ActiveChannels = 11
Case "13CH" : MOD_Tracker = "TakeTracker (PC) 13 channels" : MOD_ActiveChannels = 13
Case "15CH" : MOD_Tracker = "TakeTracker (PC) 15 channels" : MOD_ActiveChannels = 15
Case "16CN" : MOD_Tracker = "TakeTracker (PC) 16 channels" : MOD_ActiveChannels = 16
Case "32CN" : MOD_Tracker = "TakeTracker (PC) 32 channels" : MOD_ActiveChannels = 32
Case "CD81" : MOD_Tracker = "Oktalyzer  (Atari ST) 8 channels" : MOD_ActiveChannels = 8
Case "OCTA" : MOD_Tracker = "Oktalyzer  (Atari ST) 8 channels" : MOD_ActiveChannels = 8
Case "N.T." : MOD_Tracker = "Noisetracker (Linux) 32 channels" : MOD_ActiveChannels = 32
Case "CD81" : MOD_Tracker = "Falcon (Atari) 8 channels" : MOD_ActiveChannels = 8
Default 	MOD_Tracker = "Not a valid format !" : MOD_ActiveChannels = 0 : Return 0 ; not a valid mod format

End Select

SeekFile (tempmod,0) ; read module name

For i = 1 To 20
		temp = ReadByte (tempmod)
			If temp = 0 MOD_Name = MOD_Name + Chr$(32)
			If temp >0 MOD_Name = MOD_Name + Chr$(temp)
Next

offset = 20 ; read sample name
Dim MOD_SampleName$ (30)
For n = 0 To 30
	SeekFile (tempmod,offset) 
		For i = 1 To 22
			temp = ReadByte (tempmod)
				If temp = 0 MOD_SampleName(n) = MOD_SampleName(n) + Chr$(32)
				If temp >0 MOD_SampleName(n) = MOD_SampleName(n) + Chr$(temp)
		Next
	offset=offset+30
Next

Local tempbank = CreateBank(2)	;big endian	
offset = 42 ; read samples
Dim MOD_SampleAttrib (30,4)
For n = 0 To 30
	SeekFile (tempmod,offset) 
		
		temp = ReadByte (tempmod) : PokeByte	tempbank,1,temp ; read sample lenght
		temp = ReadByte (tempmod) : PokeByte	tempbank,0,temp
			MOD_SampleAttrib(n,0) = PeekShort (tempbank,0)*2
		
		temp = ReadByte (tempmod) ; read fine tune
			If temp >7 Then temp = temp -16
				MOD_SampleAttrib(n,1) = temp
 
		MOD_SampleAttrib(n,2) = ReadByte (tempmod) ; read volume
		
		temp = ReadByte (tempmod) : PokeByte	tempbank,1,temp ; read loop start
		temp = ReadByte (tempmod) : PokeByte	tempbank,0,temp
			MOD_SampleAttrib(n,3) = PeekShort (tempbank,0)*2

		temp = ReadByte (tempmod) : PokeByte	tempbank,1,temp ; read loop end
		temp = ReadByte (tempmod) : PokeByte	tempbank,0,temp
			temp = PeekShort (tempbank,0)*2
			If temp <3 Then temp =0 ; 2 byte protection
			MOD_SampleAttrib(n,4) = temp
	
	offset=offset+30
Next
FreeBank tempbank ; big endian

SeekFile (tempmod, 950)
	MOD_Orders = ReadByte (tempmod) ; lenght of song

SeekFile (tempmod, 952)
	Dim MOD_OrderList%(MOD_Orders-1) ;get orders and last pattern
		MOD_Patterns = 0
		For i = 0 To (MOD_Orders-1)
			temp = ReadByte (tempmod)
			If temp > MOD_Patterns  Then MOD_Patterns = temp
		MOD_OrderList (i) = temp
		Next
		MOD_Patterns=MOD_Patterns+1; add last pattern

SeekFile (tempmod,1084) ; read pattern datas

Dim MOD_Pat_Note$ (((MOD_Patterns*64)-1),(MOD_ActiveChannels-1)) ; create dims
Dim MOD_Pat_Sample% (((MOD_Patterns*64)-1),(MOD_ActiveChannels-1))
Dim MOD_Pat_RSample$ (((MOD_Patterns*64)-1),(MOD_ActiveChannels-1))
Dim MOD_Pat_Fx% (((MOD_Patterns*64)-1),(MOD_ActiveChannels-1))
Dim MOD_Pat_RFx$ (((MOD_Patterns*64)-1),(MOD_ActiveChannels-1))

For m = 0 To ((MOD_Patterns*64)-1)
		For n = 0 To (MOD_ActiveChannels-1) ; fill rows
	
			bin1$= Right(Bin(ReadByte(tempmod)),8) ; read block
			bin2$= Right(Bin(ReadByte(tempmod)),8)
			bin3$= Right(Bin(ReadByte(tempmod)),8)
			bin4$= Right(Bin(ReadByte(tempmod)),8)

			tempbin = Mid(bin1$,5,4)+Mid(bin2$,1,8) ; get note value
					temp = 0 
					For i=1 To Len(tempbin)
					temp = temp+(2^(Len(tempbin)-i)*(Mid$(tempbin,i,1) And "1"))
					Next
			MOD_Pat_Note (m,n) = MOD_MakeNoteString$ (temp)

			tempbin = Mid(bin1$,1,4)+Mid(bin3$,1,4) ; get sample value
					temp = 0 
					For i=1 To Len(tempbin)
					;temp = temp+(2^(Len(tempbin)-i)*(Asc(Mid$(tempbin,i,1))-48))
					temp = temp+(2^(Len(tempbin)-i)*(Mid$(tempbin,i,1) And "1"))
					Next
			MOD_Pat_Sample (m,n) = temp
				If temp = 0 MOD_Pat_RSample (m,n) = "--"
					If temp > 0 Then
							If temp >9 MOD_Pat_RSample (m,n) = temp
							If temp = 9 MOD_Pat_RSample (m,n) = "09"	
							If temp = 8 MOD_Pat_RSample (m,n) = "08"
							If temp = 7 MOD_Pat_RSample (m,n) = "07"
							If temp = 6 MOD_Pat_RSample (m,n) = "06"
							If temp = 5 MOD_Pat_RSample (m,n) = "05"
							If temp = 4 MOD_Pat_RSample (m,n) = "04"
							If temp = 3 MOD_Pat_RSample (m,n) = "03"
							If temp = 2 MOD_Pat_RSample (m,n) = "02"
							If temp = 1 MOD_Pat_RSample (m,n) = "01"
					EndIf

			tempbin = Mid(bin3$,5,4)+Mid(bin4$,1,8) ; get fx $ value
					temp = 0 
					For i=1 To Len(tempbin)
					temp = temp+(2^(Len(tempbin)-i)*(Mid$(tempbin,i,1) And "1"))
					Next
			MOD_Pat_Fx (m,n) = temp
					temphex = Hex$(temp)
					tempcut = Replace(temphex,"00000","")		
						If tempcut = "000" tempcut = "---"
			MOD_Pat_RFx (m,n) = tempcut
		Next
Next
	
CloseFile (tempmod) ; clear up

Return 1
End Function 

Function MOD_MakeNoteString$ (value%)
	Local temp$ 
	If MOD_Amiga = 0 Then 
		Select value
			Case 6868 : temp = "C-1"
			Case 6464 : temp = "C#1"
			Case 6096 : temp = "D-1"
			Case 5760 : temp = "D#1"
			Case 5424 : temp = "E-1"
			Case 5120 : temp = "F-1"
			Case 4832 : temp = "F#1"
			Case 4560 : temp = "G-1"
			Case 4304 : temp = "G#1"
			Case 4064 : temp = "A-1"
			Case 3840 : temp = "A#1"
			Case 3624 : temp = "B-1"

			Case 3424 : temp = "C-2"
			Case 3232 : temp = "C#2"
			Case 3048 : temp = "D-2"
			Case 2880 : temp = "D#2"
			Case 2715 : temp = "E-2"
			Case 2560 : temp = "F-2"
			Case 2416 : temp = "F#2"
			Case 2280 : temp = "G-2"
			Case 2152 : temp = "G#2"
			Case 2032 : temp = "A-2"
			Case 1920 : temp = "A#2"
			Case 1812 : temp = "B-2"

			Case 1712 : temp = "C-3"
			Case 1616 : temp = "C#3"
			Case 1525 : temp = "D-3"
			Case 1440 : temp = "D#3"
			Case 1357 : temp = "E-3"
			Case 1281 : temp = "F-3"
			Case 1209 : temp = "F#3"
			Case 1141 : temp = "G-3"
			Case 1077 : temp = "G#3"
			Case 1017 : temp = "A-3"
			Case 961 : temp = "A#3"
			Case 907 : temp = "B-3"

			Case 856 : temp = "C-4"
			Case 808 : temp = "C#4"
			Case 762 : temp = "D-4"
			Case 720 : temp = "D#4"
			Case 678 : temp = "E-4"
			Case 640 : temp = "F-4"
			Case 604 : temp = "F#4"
			Case 570 : temp = "G-4"
			Case 538 : temp = "G#4"
			Case 508 : temp = "A-4"
			Case 480 : temp = "A#4"
			Case 453 : temp = "B-4"

			Case 428 : temp = "C-5"
			Case 404 : temp = "C#5"
			Case 381 : temp = "D-5"
			Case 360 : temp = "D#5"
			Case 339 : temp = "E-5"
			Case 320 : temp = "F-5"
			Case 302 : temp = "F#5"
			Case 285 : temp = "G-5"
			Case 269 : temp = "G#5"
			Case 254 : temp = "A-5"
			Case 240 : temp = "A#5"
			Case 226 : temp = "B-5"

			Case 214 : temp = "C-6"
			Case 202 : temp = "C#6"
			Case 190 : temp = "D-6"
			Case 180 : temp = "D#6"
			Case 170 : temp = "E-6"
			Case 160 : temp = "F-6"
			Case 151 : temp = "F#6"
			Case 143 : temp = "G-6"
			Case 135 : temp = "G#6"
			Case 127 : temp = "A-6"
			Case 120 : temp = "A#6"
			Case 113 : temp = "B-6"

			Case 107 : temp = "C-7"
			Case 101 : temp = "C#7"
			Case 95 : temp = "D-7"
			Case 90 : temp = "D#7"
			Case 85 : temp = "E-7"
			Case 80 : temp = "F-7"
			Case 76 : temp = "F#7"
			Case 71 : temp = "G-7"
			Case 67 : temp = "G#7"
			Case 64 : temp = "A-7"
			Case 60 : temp = "A#7"
			Case 57 : temp = "B-7"

			Case 54 : temp = "C-8"
			Case 51 : temp = "C#8"
			Case 48 : temp = "D-8"
			Case 45 : temp = "D#8"
			Case 43 : temp = "E-8"
			Case 40 : temp = "F-8"
			Case 38 : temp = "F#8"
			Case 36 : temp = "G-8"
			Case 34 : temp = "G#8"
			Case 32 : temp = "A-8"
			Case 30 : temp = "A#8"
			Case 29 : temp = "B-8"

			Case 27 : temp = "C-9"
			Case 26 : temp = "C#9"
			Case 24 : temp = "D-9"
			Case 23 : temp = "D#9"
			Case 22 : temp = "E-9"
			Case 20 : temp = "F-9"
			Case 19 : temp = "F#9"
			Case 18 : temp = "G-9"
			Case 17 : temp = "G#9"
			Case 16 : temp = "A-9"
			Case 15 : temp = "A#9"
			Case 14 : temp = "B-9"

			Default temp = "---"
		End Select
		EndIf
	If MOD_Amiga = 1 Then
		Select value
			Case 856 : temp = "C-1"
			Case 808 : temp = "C#1"
			Case 762 : temp = "D-1"
			Case 720 : temp = "D#1"
			Case 678 : temp = "E-1"
			Case 640 : temp = "F-1"
			Case 604 : temp = "F#1"
			Case 570 : temp = "G-1"
			Case 538 : temp = "G#1"
			Case 508 : temp = "A-1"
			Case 480 : temp = "A#1"
			Case 453 : temp = "B-1"

			Case 428 : temp = "C-2"
			Case 404 : temp = "C#2"
			Case 381 : temp = "D-2"
			Case 360 : temp = "D#2"
			Case 339 : temp = "E-2"
			Case 320 : temp = "F-2"
			Case 302 : temp = "F#2"
			Case 285 : temp = "G-2"
			Case 269 : temp = "G#2"
			Case 254 : temp = "A-2"
			Case 240 : temp = "A#2"
			Case 226 : temp = "B-2"

			Case 214 : temp = "C-3"
			Case 202 : temp = "C#3"
			Case 190 : temp = "D-3"
			Case 180 : temp = "D#3"
			Case 170 : temp = "E-3"
			Case 160 : temp = "F-3"
			Case 151 : temp = "F#3"
			Case 143 : temp = "G-3"
			Case 135 : temp = "G#3"
			Case 127 : temp = "A-3"
			Case 120 : temp = "A#3"
			Case 113 : temp = "B-3"
			Default temp = "---"
		End Select
		EndIf			
Return temp
End Function

Function MOD_Reset()
MOD_Name$ = ""
MOD_Orders% = 0
MOD_Tracker$ = "" 
MOD_ActiveChannels% = 0
MOD_Id$ = ""
MOD_Patterns% = 0
Dim MOD_SampleName$ (0)
Dim MOD_SampleAttrib% (0,0)
Dim MOD_OrderList% (0)
Dim MOD_Pat_Note$ (0,0)
Dim MOD_Pat_Sample% (0,0)
Dim MOD_Pat_Fx% (0,0)
Dim MOD_Pat_RFx$ (0,0)
Dim MOD_Pat_RSample$ (0,0)
End Function


All this will be includet in a next version off BBS, but not now (no time)

cu