STsound / YM2149 programming

Advanced game related topics
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:

Re: STsound / YM2149 programming

Post by dobro »

in french
il y a quelques temps KarlKox avait fait un code qui utilisait une Dll capable de lire les fichiers au format *.ym

j'ai mis a jour ce player a la version 5.20 LTS de Purebasic
in translate :
here is some time KarlKox had a code that used a DLL can read files in *. ym

I updated the player has the 5.20 LTS version Purebasic
in french
voici le code :
in translate:
Here is the code
(mode ThreadSafe ON )

Code: Select all

; PureBasic Visual Designer v3.81 build 1321

; YM Engine By Leonard ( http://leonard.oxg.free.fr/ ) 
; PureBasic Port by KarLKoX ( KarLKoX@ifrance.com )

; PureBasic Visual Designer v3.81 build 1321
; mis en purebasic v.5.20 par Dobro

;- Window Constants
;
Enumeration
	#Window
EndEnumeration
Enumeration
	#file2
EndEnumeration

;- Gadget Constants
;
Enumeration
	#btnStop
	#btnPause
	#btnPlay
	#btnOpen
	#TrackBar
	#Frame3D_1
	#lblArtist
	#lblTitle
	#lblComment
	#lblDuration
	;  #lblBitrate
	#lblReplayer
	#lblType
	
	#artist
	#title
	#comment
	#duration
	#replayer
	#type
	
	#sldVolume
EndEnumeration




; YM Engine By Leonard ( http://leonard.oxg.free.fr/ )
; PureBasic Port by KarLKoX ( KarLKoX@ifrance.com )

#YM   = 0

Structure ymMusicInfo_t
	pSongName.l
	pSongAuthor.l
	pSongComment.l
	pSongType.l
	pSongPlayer.l
	musicTimeInSec.l
EndStructure


Declare MyCallback(WindowID, message, wParam, lParam)
Declare Open_Window()
Declare Init_YM_DLL()
Declare Close_YM_DLL()

Declare YM_Init()
Declare YM_Open(Path.s, pBlock.l, nSize.l)
Declare YM_Play()
Declare YM_Pause()
Declare YM_Stop()
Declare YM_Seek(seconds.l)
Declare YM_SetVolume(newvolume.l)
Declare YM_Close()
Declare YM_Get_Info(info.l)
Declare.l YM_FFT()


Global m_bSeeking.b, m_bPlaying.b, m_bPause.b, m_bActive.b
Global m_lngTimerID.l, m_hThread.l ,flag=0

Structure fftarray 
	Value.f[512] 
EndStructure

Structure bar_heights
	Value.w[256]
EndStructure
Global bar.bar_heights

#SpectrumImage = 1 

Declare updateFFT(Value)
Declare MyCallback(WindowID, message, wParam, lParam)

Global scale.f, x00.f, y00.f

; Logarithmic values are taken from the "simple spectrum" xmms plugin
scale.f = 100 / ( Log((1 - 0.33) / 0.33) * 2 )
x00.f = 0.33*0.33*64/(2 * 0.33 - 1)
y00.f = -Log(-x00) * scale



If InitSprite() = 0 
	MessageRequester("","Problem with InitSprite()",0):End 
EndIf 
Open_Window()

CreateImage(#SpectrumImage,256,100)

Init_YM_DLL()
YM_Init()
SendMessage_(GadgetID(#sldVolume), #TBM_SETRANGE, 0, 0 | ((255)<<16) )
SetGadgetState(#sldVolume, 255)
if flag=1
	m_hThread=CreateThread(@updateFFT(),0) 
	
	
	m_lngTimerID = SetTimer_(WindowID(WindowID), 0, 1000, 0)
	m_bActive   = #True
	m_bPause    = #False
	m_bPlaying  = #False
	flag=0
Endif

Repeat
	
	Event = WaitWindowEvent(20)
	
	Select Event
		
		Case #PB_Event_Gadget
		GadgetID = EventGadget()
		
		Select GadgetID
			
			Case #btnStop
			;-stop
			YM_Stop()
			m_bPlaying = #False
			m_secondes = 0
			SetGadgetState(#TrackBar, (m_secondes))
			ClearScreen(RGB(0, 0, 0))          
			
			Case #btnPause
			;-pause
			m_bPause ! 1
			If (m_bPause = #True)
				SetGadgetText(#btnPause, "Resume")
				YM_Pause()
				Else
				SetGadgetText(#btnPause, "Pause")
				YM_Play()            
			EndIf
			
			Case #btnPlay
			;-play
			YM_Play()
			m_bPlaying = #True
			
			Case #btnOpen
			;-open
			openfile (#file2,"chemin.inf")
			path$=readString (#file2)
			CloseFile(#file2)
			If path$=""
				Path$="c:\"
			Endif
			Filename$ = OpenFileRequester("Please choose a file to play", Path$, "YM Music|*.ym", 0)
			path$=GetPathPart(Filename$)
			openfile (#file2,"chemin.inf")
			WriteString (#file2,path$)
			CloseFile(#file2)
			;- Read the file and hold all the data to a block of data  
			if Filename$<>""
				Result = ReadFile(0, Filename$)
				If (Result = 0)
					MessageRequester("Error", "An error occured while reading the file " + Filename$)
				EndIf
				nSize = Lof(0)
				Datas = AllocateMemory(nSize)
				ReadData(0,Datas, nSize)
				
				If (Filename$ <> "")
					If (m_bPlaying = #True) 
						YM_Stop()
						m_bPlaying = #False
						If (Filename$ <> m_cursong$)
							YM_Close()
							YM_Init()
							SetGadgetState(#TrackBar, 0)
							; the label gadgets are not updated so i tell windows to do it (don't know why ??)
							SendMessage_(WindowID(#Window), #WM_PAINT, 0, 0)
						EndIf
					EndIf
				EndIf
				m_cursong$ = Filename$          
				If (m_cursong$)
					; if you don't want to load from memory, put 0 to the 2nd and the 3rd parameter
					YM_Open(m_cursong$, Datas, nSize)
					YM_Get_Info(info.ymMusicInfo_t)
					SetGadgetText(#title, PeekS(info\pSongName))
					SetGadgetText(#artist, PeekS(info\pSongAuthor))      
					SetGadgetText(#comment, PeekS(info\pSongComment))            
					SetGadgetText(#type, PeekS(info\pSongType))      
					SetGadgetText(#replayer, PeekS(info\pSongPlayer))            
					SetGadgetText(#duration, Str(info\musicTimeInSec) + " seconds")                  
					SendMessage_(GadgetID(#TrackBar),  #TBM_SETRANGE, 0, 0 | ((info\musicTimeInSec)<<16) )
					YM_SetVolume(255)
				EndIf
			Endif
			
		EndSelect
		
		Case #WM_TIMER
		If (m_bPlaying = #True) And (m_bPause = #False)
			m_secondes + 1        
			If m_bSeeking = #False
				SetGadgetState(#TrackBar, (m_secondes))
			EndIf
			Else
			If (m_bPause = #False)
				SetGadgetState(#TrackBar, 0)
			EndIf
		EndIf
		
		Case #WM_LBUTTONUP
		newpos.l = GetGadgetState(#TrackBar)
		m_secondes = newpos
		Debug m_secondes
		YM_Seek(newpos)
		m_bSeeking = #False
		
	EndSelect
	
Until Event = #PB_Event_CloseWindow

m_bActive = 0
If (m_hTread) : KillThread(m_hThread) : EndIf ; <<<<<<< ne pas activer cette ligne (Dobro)
If (m_lngTimerID) : KillTimer_(WindowID(#Window), m_lngTimerID) : EndIf
If (m_bPlaying) : YM_Stop() : EndIf

YM_Close()
Close_YM_DLL()



End

;- Procedures Zone

Procedure Open_Window()
	;-openwindow
	hwnd = OpenWindow(#Window, 405, 71, 332, 385,  "Simple YM Player by KarLKoX",#PB_Window_SystemMenu | #PB_Window_TitleBar )
	SetWindowCallback(@MyCallback()) :flag=1
	;If (hwnd)
	offscreen = OpenWindowedScreen(WindowId(#Window), 40,280, 256,100,0,0,0) 
	If offscreen = 0
		MessageRequester("","Problem with OpenWindowedScreen()",0):End 
	EndIf
	; If CreateGadgetList(WindowID(#Window))
	ButtonGadget(#btnStop, 170, 9, 68, 30, "Stop")
	ButtonGadget(#btnPause, 90, 9, 68, 30, "Pause")
	ButtonGadget(#btnPlay, 10, 9, 68, 30, "Play")
	ButtonGadget(#btnOpen, 250, 9, 68, 30, "Open")
	TrackBarGadget(#TrackBar, 13, 42, 304, 25, 0, 10)
	FrameGadget(#Frame3D_1, 13, 100, 302, 175, "YM Informations")
	TextGadget(#lblArtist, 23, 115, 89, 18, "Artist")
	TextGadget(#lblTitle, 23, 140, 89, 18, "Title")
	TextGadget(#lblComment, 23, 165, 89, 18, "Comment")
	TextGadget(#lblDuration, 23, 190, 89, 18, "Duration")
	;      TextGadget(#lblBitrat, 23, 175, 89, 18, "Bitrate")
	TextGadget(#lblReplayer, 23, 215, 89, 18, "Replayer")
	TextGadget(#lblType, 23, 240, 89, 18, "Songtype")
	
	TextGadget(#artist, 90, 115, 200, 20, "")
	TextGadget(#title, 90, 140, 200, 20, "")
	TextGadget(#comment, 90, 165, 200, 20, "")
	TextGadget(#duration, 90, 190, 200, 20, "")
	TextGadget(#replayer, 90, 215, 200, 20, "")
	TextGadget(#type, 90, 240, 200, 20, "")
	
	TrackBarGadget(#sldVolume, 13, 70, 304, 25, 0, 255)      
	;EndIf
	;EndIf
EndProcedure



; Instanciate The DLL

Procedure Init_YM_DLL()
	Protected *DLL
	*DLL = OpenLibrary(#YM, "YmPlugin.dll")
	If *DLL = 0
		MessageRequester("Error", "Can't load YmPlugin.dll", 0)
		End
		Else
		ProcedureReturn *DLL
	EndIf
EndProcedure

Procedure Close_YM_DLL()
	ProcedureReturn CloseLibrary(#YM)
EndProcedure

Procedure YM_Init()
	ProcedureReturn CallFunction(#YM, "_YM_Init@0")
EndProcedure

Procedure YM_Open(Path.s, pBlock.l, nSize.l)
	ProcedureReturn CallFunction(#YM, "_YM_Open@12", @Path.s, pBlock.l, nSize.l)
EndProcedure

Procedure YM_Play()
	ProcedureReturn CallFunction(#YM, "_YM_Play@0")
EndProcedure

Procedure YM_Pause()
	ProcedureReturn CallFunction(#YM, "_YM_Pause@0")
EndProcedure

Procedure YM_Stop()
	ProcedureReturn CallFunction(#YM, "_YM_Stop@0")
EndProcedure

Procedure YM_Seek(seconds.l)
	ProcedureReturn CallFunction(#YM, "_YM_Seek@4", seconds.l)
EndProcedure

Procedure YM_SetVolume(newvolume.l)
	ProcedureReturn CallFunction(#YM, "_YM_SetVolume@4", newvolume.l)
EndProcedure

Procedure YM_Close()
	ProcedureReturn CallFunction(#YM, "_YM_Close@0")
EndProcedure

Procedure YM_Get_Info(info.l)
	ProcedureReturn CallFunction(#YM, "_YM_Get_Info@4", info)
EndProcedure

Procedure.l YM_FFT()
	ProcedureReturn CallFunction(#YM, "_YM_FFT@0")
EndProcedure


;- a VERY bad spectrum analyzer but it show that YM_FFT() works :)  
Procedure updateFFT(Value) 
	ClearScreen(RGB(0, 0, 0))
	FlipBuffers() 
	
	While m_bActive
		StartDrawing(ScreenOutput()) 
			If (m_bPlaying)
				
				; Return an array of 512 floats
				CopyMemory(YM_FFT(), hfft.fftarray, 4*512) 
				
				; logarithmic amplitude
				For i=0 To 255 
					fft.f =  (hfft\Value[i])
					Y = ( Log(fft - x00) * scale + y00 )
					
					If (i = 255)
						tmp = Y
						Else
						tmp = bar\Value[i+1] / 4
					EndIf
					
					If (i = 0)
						tmp2 = Y
						Else
						tmp2 = bar\Value[i-1] + tmp
					EndIf
					
					Y = 2 * Y + tmp
					Y = (2 * bar\Value[i] + Y) / 3
					y1 = Y
					
					If (Y < 0)
						Y = 0
					EndIf
					
					bar\Value[i] =  Y
					
					Y = 100 - 1 - bar\Value[i]
					If (Y < 0)
						Y = 0
					EndIf
					
					If (i < Y)
						rgbRed   = i << 1
						rgbGreen = $FF - (i << 1)
						rgbBlue  = $1F
						Else
						rgbRed   = Y << 1
						rgbGreen = $FF - (Y << 1)
						rgbBlue  = $1F
					EndIf
					
					color = RGB(rgbRed, rgbGreen, rgbBlue)
					LineXY(i, 100, i, Y, color)
				Next 
				
			EndIf
			
		StopDrawing()    
		FlipBuffers() 
		
		Delay(20)     
		ClearScreen(RGB(0, 0, 0))
		
	Wend
	
	
	
EndProcedure

;- This Callback Is Here To Be Used To Process Some Windows Events
Procedure MyCallback(WindowID, message, wParam, lParam)
	
	ReturnValue =  #PB_ProcessPureBasicEvents
	
	If message = #WM_HSCROLL
		If lParam = GadgetID(#TrackBar)
			m_bSeeking = #True
			ReturnValue = 1
			ElseIf lParam = GadgetID(#sldVolume)
			newvol = GetGadgetState(#sldVolume)
			If newvol <= 0 : newvol = 1 : EndIf
			YM_SetVolume(newvol)
			ReturnValue = 1      
		EndIf
	EndIf
	
	ProcedureReturn  ReturnValue
EndProcedure

; EPB
in french
voici un lien vers l'archive qui comprends le code 'Main.pb' et la fameuse Dll
in translate :
Here is a link to the archive that understand the code 'Main.pb' and the famous DLLs
http://michel.dobro.free.fr/Forum_pb/Ka ... gin-PB.zip

in translate
You will find full file * ym here.:
http://low.fi/~visy/ym-archive/

:) thanks to Karlkox
Last edited by dobro on Fri Nov 29, 2013 11:58 am, edited 4 times in total.
Image
Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/
infratec
Always Here
Always Here
Posts: 6818
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: STsound / YM2149 programming

Post by infratec »

To make it 5.20 compatible:

Code: Select all

Procedure.i Init_YM_DLL()
  Protected *DLL
  
  *DLL = OpenLibrary(#YM, "YmPlugin.dll")
  If *DLL = 0
    MessageRequester("Error", "Can't load YmPlugin.dll", 0)
    End
  Else
    ProcedureReturn *DLL
  EndIf
EndProcedure

Code: Select all

Procedure YM_Open(Path.s, pBlock.l, nSize.l)
    ProcedureReturn CallFunction(#YM, "_YM_Open@12", @Path, pBlock, nSize)
EndProcedure

Code: Select all

Procedure Open_Window()
    hwnd = OpenWindow(#Window, 405, 71, 332, 385,  "Simple YM Player by KarLKoX",#PB_Window_SystemMenu | #PB_Window_TitleBar )
    If (hwnd)
        offscreen = OpenWindowedScreen(hwnd, 40,280, 256,100,0,0,0) 
        If offscreen = 0
            MessageRequester("","Problem with OpenWindowedScreen()",0):End 
        EndIf

        ButtonGadget(#btnStop, 170, 9, 68, 30, "Stop")
        ButtonGadget(#btnPause, 90, 9, 68, 30, "Pause")
        ButtonGadget(#btnPlay, 10, 9, 68, 30, "Play")
        ButtonGadget(#btnOpen, 250, 9, 68, 30, "Open")
        TrackBarGadget(#TrackBar, 13, 42, 304, 25, 0, 10)
        FrameGadget(#Frame3D_1, 13, 100, 302, 175, "YM Informations")
        TextGadget(#lblArtist, 23, 115, 89, 18, "Artist")
        TextGadget(#lblTitle, 23, 140, 89, 18, "Title")
        TextGadget(#lblComment, 23, 165, 89, 18, "Comment")
        TextGadget(#lblDuration, 23, 190, 89, 18, "Duration")
        ;      TextGadget(#lblBitrat, 23, 175, 89, 18, "Bitrate")
        TextGadget(#lblReplayer, 23, 215, 89, 18, "Replayer")
        TextGadget(#lblType, 23, 240, 89, 18, "Songtype")
        
        TextGadget(#artist, 73, 115, 200, 33, "")
        TextGadget(#title, 73, 140, 200, 33, "")
        TextGadget(#comment, 73, 165, 200, 33, "")
        TextGadget(#duration, 73, 190, 200, 33, "")
        TextGadget(#replayer, 73, 215, 200, 33, "")
        TextGadget(#type, 73, 240, 200, 33, "")
        
        TrackBarGadget(#sldVolume, 13, 70, 304, 25, 0, 255)      
        
    EndIf
EndProcedure
And to make it more bug free:

Code: Select all

If IsFile(0) : CloseFile(0) : EndIf
End
Bernd
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:

Re: STsound / YM2149 programming

Post by dobro »

infratec wrote:To make it 5.20 compatible:
Bernd

:lol:
my previous message is already converting to 5.20 .... :mrgreen:
Image
Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/
infratec
Always Here
Always Here
Posts: 6818
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: STsound / YM2149 programming

Post by infratec »

Hi Dobro,

Since I needed all, I downloaded the file from your link.
Unfortunately the changes for 5.20 are (still) not inside.

http://michel.dobro.free.fr/Forum_pb/Ka ... player.zip

Please change also the file inside this zip file.

Bernd
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:

Re: STsound / YM2149 programming

Post by dobro »

when in doubt, I remade my archive, and re-edited my code


However, at my home, everything works in PureBasic x86 5.20 :shock:


Moreover, the code posted above, is for Version 5.20 ....

I do not understand why it does not run at your home

[Reedit]
(compiler in ThreadSafe mode !!! )

link corrected ...
Image
Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/
User avatar
zxtunes.com
Enthusiast
Enthusiast
Posts: 375
Joined: Wed Apr 23, 2008 7:51 am
Location: Saint-Petersburg, Russia
Contact:

Re: STsound / YM2149 programming

Post by zxtunes.com »

infratec wrote:Hi Dobro,

Since I needed all, I downloaded the file from your link.
Unfortunately the changes for 5.20 are (still) not inside.

http://michel.dobro.free.fr/Forum_pb/Ka ... player.zip

Please change also the file inside this zip file.

Bernd
ERREUR 404 - Document non trouvé :oops:
User avatar
zxtunes.com
Enthusiast
Enthusiast
Posts: 375
Joined: Wed Apr 23, 2008 7:51 am
Location: Saint-Petersburg, Russia
Contact:

Re: STsound / YM2149 programming

Post by zxtunes.com »

I recomended AYFLY.DLL

https://code.google.com/p/ayfly/downloads/list

It powefull lib, has play: YM,AY,pt3 and more ZX Spectrum music formats.

Have ASCC and Unicode lib.
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:

Re: STsound / YM2149 programming

Post by dobro »

zxtunes.com wrote:
infratec wrote:Hi Dobro,

Since I needed all, I downloaded the file from your link.
Unfortunately the changes for 5.20 are (still) not inside.

http://michel.dobro.free.fr/Forum_pb/Ka ... player.zip

Please change also the file inside this zip file.

Bernd
ERREUR 404 - Document non trouvé :oops:

ici :
http://michel.dobro.free.fr/Forum_pb/Ka ... gin-PB.zip
Image
Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/
Post Reply