Special thanks to the VLC authors and D.J Peters who helped figure out the callbacks.
Download source code with libraries, plugins and sample video files here: https://sourceforge.net/projects/freebasic-vlc/
Code: Select all
' ***********************************************
' * fbvlc - FreeBASIC video player using libvlc *
' ***********************************************
' By Cleber M. Casali
' Special thanks to the VLC autors, and D.J. Peters who helped me understand the callback functions.
' This code is free to use for any free or commercial project. Credit is appreciated.
' I know there are libvlc headers for FreeBASIC, but in my own project, I didn't want libvlc to be a hard dependency.
' I have only included the necessary plugins to play theora videos, which is all I need.
' If you need to play other formats, just drop the plugins in the platform's corresponding 'plugin' directory.
' ------------------------------------------------------------------
' VIDEO MODE STARTUP
'comment the next line to use fbgfx only
#define use_opengl
#ifdef use_opengl
'USING OPENGL
'OpenGL headers
#include once "GL/gl.bi"
#include once "GL/glext.bi"
'vsync procedures
dim shared glSwapInterval as function (byval interval as gluint) as gluint 'glXSwapIntervalSGI glXSwapIntervalMESA wglSwapIntervalEXT
dim shared glXSwapIntervalEXT as sub (display_ptr as any ptr, byval drawable as gluint, byval interval as gluint) 'PFNGLXSWAPINTERVALEXTPROC 'DRI2SwapInterval 'glXSwapIntervalEXT
sub searchSwapIntervalMethod()
'find a suitable method for vsync
if glXSwapIntervalEXT=0 then glXSwapIntervalEXT = ScreenGLProc("glXSwapIntervalEXT")
if glXSwapIntervalEXT=0 then glXSwapIntervalEXT = ScreenGLProc("DRI2SwapInterval")
if glSwapInterval=0 then glSwapInterval = ScreenGLProc("wglSwapIntervalEXT")
if glSwapInterval=0 then glSwapInterval = ScreenGLProc("glXSwapIntervalSGI")
if glSwapInterval=0 then glSwapInterval = ScreenGLProc("glXSwapIntervalMESA")
end sub
#ifdef __FB_UNIX__
'declare some GLX stuff
extern "C" lib "GL"
declare function glXGetCurrentDisplay() as any ptr
declare function glXGetCurrentDrawable() as gluint
end extern
#endif
sub gl_setvsync(byval interval as integer=1) 'enable or disable vsync
if glSwapInterval then glSwapInterval(interval) : exit sub
#ifdef __FB_UNIX__
if glXSwapIntervalEXT then glXSwapIntervalEXT(glXGetCurrentDisplay(), glXGetCurrentDrawable(), interval) : exit sub
#endif
end sub
sub gl_init(byval x as integer, byval y as integer) 'init opengl stuff
glMatrixMode(GL_PROJECTION)
glLoadIdentity
glPushMatrix 'store matrix
glMatrixMode(GL_MODELVIEW)
glLoadIdentity()
glOrtho -x\2, x\2, y\2, -y\2, 0.0 , 10.0 ' ortho with (0,0) at center
glPushMatrix() 'store matrix
glClearColor 0.0, 0.0, 0.0, 1.0
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT 'clear gl buffer
glDisable (GL_DEPTH_TEST)
glDisable (GL_TEXTURE_2D)
gl_setVsync(1)
flip()
end sub
sub gl_Put(byval x as glfloat, byval y as glfloat, byval buffer as any ptr)
if buffer=0 then exit sub
dim as integer xx,yy,pitch, bypp
dim as ubyte ptr pixels
if imageinfo(buffer,xx,yy,bypp,pitch,pixels) then exit sub
dim as integer pitch4=pitch/bypp
glRasterPos2d(0, 0)
glPixelZoom( 1, -1) 'otherwise it will render upside-down
glBitmap 0, 0, 0, 0, (x - xx/2), -(y - yy/2), 0 'fix raster and move bitmap
glDrawPixels(pitch4, yy, GL_BGRA, GL_UNSIGNED_BYTE, pixels) 'deprecated - you should use textures instead
end sub
sub initScreen(byval x as integer=1280, byval y as integer=720, byval fullscreen as integer=0, byval syncrate as integer=60)
screenres x, y, 32, 1, iif(fullscreen,&h01,0) or &h02, syncrate 'set video mode
WindowTitle "fbvlc - OpenGL" 'set window title
gl_init(x,y)
end sub
#else
'NOT USING OPENGL
sub initScreen(byval x as integer=1280, byval y as integer=720, byval fullscreen as integer=0, byval syncrate as integer=60)
screenres x, y, 32, 2, iif(fullscreen,&h01,0) or 0, syncrate 'set video mode
WindowTitle "fbvlc - fbgfx" 'set window title
end sub
#endif
' ------------------------------------------------------------------
' FBVLC
'libvlc types
type libvlc_media_player_t as any
type libvlc_instance_t as any
type libvlc_media_t as any
type libvlc_state_t as long
type libvlc_video_lock_cb as function cdecl(byval opaque as any ptr, byval planes as any ptr ptr) as any ptr
type libvlc_video_unlock_cb as sub cdecl(byval opaque as any ptr, byval picture as any ptr, byval planes as any const ptr ptr)
type libvlc_video_display_cb as sub cdecl(byval opaque as any ptr, byval picture as any ptr)
'yeah, some enumerations
enum
libvlc_NothingSpecial = 0
libvlc_Opening
libvlc_Buffering
libvlc_Playing
libvlc_Paused
libvlc_Stopped
libvlc_Ended
libvlc_Error
end enum
'our libvlc class
type fbvlctype
started as boolean=false
libavutil_ptr as any ptr
libswscale_ptr as any ptr
libvlccore_ptr as any ptr
libvlc_ptr as any ptr
instance as libvlc_instance_t Ptr
player as libvlc_media_player_t Ptr
playerState as libvlc_state_t
videoEnded as boolean=true
media as libvlc_media_t Ptr
vlcmutex as any ptr
internal_image as any ptr
image as any ptr
xsize as integer
ysize as integer
pitch as integer
declare sub init()
declare sub load(byval filename as string="")
declare sub setVolume(byval volume as integer=100)
declare sub playVideoFile(byval filename as string="", byval volume as integer=100)
declare sub sync()
declare sub drawToScreen()
declare sub unload()
declare sub finish()
end type
static shared fbvlc as fbvlctype 'libvlc object
'declare libvlc procedures
dim shared libvlc_get_version as function cdecl() As ZString Ptr
dim shared libvlc_new as function cdecl (ByVal argc As Integer, ByVal argv As any Ptr) As libvlc_instance_t Ptr
dim shared libvlc_release as sub cdecl (ByVal p_instance As libvlc_instance_t Ptr)
dim shared libvlc_media_new_location as function cdecl (ByVal p_mi As libvlc_media_t Ptr, pt As ZString Ptr) As libvlc_media_t Ptr
dim shared libvlc_media_new_path as function cdecl (ByVal p_mi As libvlc_instance_t Ptr, pt As ZString Ptr) As libvlc_media_t Ptr
dim shared libvlc_media_player_new_from_media as function cdecl (ByVal p_mi As libvlc_media_t Ptr) As libvlc_media_player_t Ptr
dim shared libvlc_media_release as sub cdecl (ByVal p_md As libvlc_media_t Ptr)
dim shared libvlc_media_player_set_hwnd as sub cdecl (ByVal p_mi As libvlc_media_player_t Ptr, ByVal drawable As Any Ptr)
dim shared libvlc_media_player_set_xwindow as sub cdecl (ByVal p_mi As libvlc_media_player_t Ptr, ByVal xid As ulong)
dim shared libvlc_media_player_play as function cdecl (ByVal p_mi As libvlc_media_player_t Ptr) As Integer
dim shared libvlc_media_player_release as sub cdecl (ByVal p_mi As libvlc_media_player_t Ptr)
dim shared libvlc_media_player_stop as sub cdecl (ByVal p_mi As libvlc_media_player_t Ptr)
dim shared libvlc_audio_set_volume as function cdecl (ByVal p_mi As libvlc_media_player_t Ptr, ByVal i_volume As Integer) As Integer
dim shared libvlc_media_player_get_length as function cdecl (ByVal p_mi As libvlc_media_player_t Ptr) As Integer
dim shared libvlc_media_player_get_time as function cdecl (ByVal p_mi As libvlc_media_player_t Ptr) As Integer
dim shared libvlc_media_player_get_position as function cdecl (ByVal p_mi As libvlc_media_player_t Ptr) As Integer
dim shared libvlc_video_set_marquee_string as sub cdecl (ByVal p_mi As libvlc_media_player_t Ptr, ByVal option As UInteger, ByVal psz_text As ZString Ptr)
dim shared libvlc_video_set_marquee_int as sub cdecl (ByVal p_mi As libvlc_media_player_t Ptr, ByVal option As UInteger, ByVal i_val As Integer)
dim shared libvlc_media_player_is_playing as function cdecl (ByVal p_mi As libvlc_media_player_t Ptr) As boolean
dim shared libvlc_set_fullscreen as sub cdecl (ByVal p_mi As libvlc_media_player_t Ptr, byval b_fullscreen As boolean)
dim shared libvlc_video_set_key_input as sub cdecl (ByVal p_mi As libvlc_media_player_t Ptr, byval tovlc As boolean)
dim shared libvlc_video_set_format as sub cdecl (byval mp as libvlc_media_player_t ptr, byval chroma as const zstring ptr, byval width as ulong, byval height as ulong, byval pitch as ulong)
dim shared libvlc_media_player_get_state as function cdecl (byval p_mi as libvlc_media_player_t ptr) as libvlc_state_t
dim shared libvlc_video_set_callbacks as sub cdecl (byval mp as libvlc_media_player_t ptr, byval lock_ as libvlc_video_lock_cb, byval unlock_ as libvlc_video_unlock_cb, byval display as libvlc_video_display_cb, byval opaque as any ptr)
sub fbvlctype.init() 'initialize libvlc
if this.started then exit sub 'leave if already started
'create a scren sized image
screeninfo this.xsize, this.ysize
this.internal_image=imagecreate( this.xsize, this.ysize, rgba(0,0,0,255), 32)
this.image=imagecreate( this.xsize, this.ysize, rgba(0,0,0,255), 32)
'create a mutex
this.vlcmutex=mutexcreate()
'load libraries
#Ifdef __FB_WIN32__
if this.libvlc_ptr=0 then
#ifdef __FB_64BIT__
'load from dll64\libvlc-win64\
SetEnviron ("VLC_PLUGIN_PATH="+exepath()+"\dll64\libvlc-win64\plugins")
this.libvlccore_ptr = DyLibLoad(exepath()+"\dll64\libvlc-win64\libvlccore.dll")
this.libvlc_ptr = DyLibLoad(exepath()+"\dll64\libvlc-win64\libvlc.dll")
#else
'load from dll\libvlc-win64\
SetEnviron ("VLC_PLUGIN_PATH="+exepath()+"\dll\libvlc-win32\plugins")
this.libvlccore_ptr = DyLibLoad(exepath()+"\dll\libvlc-win32\libvlccore.dll")
this.libvlc_ptr = DyLibLoad(exepath()+"\dll\libvlc-win32\libvlc.dll")
#endif
end if
if this.libvlc_ptr=0 then this.libvlc_ptr = DyLibLoad("libvlc.dll") 'try to load libvlc from system
#Else
if this.libvlc_ptr=0 then this.libvlc_ptr = DyLibLoad("libvlc.so") 'try to load libvlc from system
if this.libvlc_ptr=0 then
#ifdef __FB_64BIT__
'load from lib64\libvlc\
SetEnviron ("VLC_PLUGIN_PATH="+exepath()+"/lib64/libvlc/vlc/plugins")
this.libavutil_ptr = DyLibLoad(exepath()+"/lib64/libavutil.so.55")
this.libswscale_ptr = DyLibLoad(exepath()+"/lib64/libswscale.so.4")
this.libvlccore_ptr = DyLibLoad(exepath()+"/lib64/libvlc/libvlccore.so.9")
this.libvlc_ptr = DyLibLoad(exepath()+"/lib64/libvlc/libvlc.so")
#else
'load from lib32\libvlc\
'the 32-bit version needs libidn11:i386 to run on 64-bit systems
SetEnviron ("VLC_PLUGIN_PATH="+exepath()+"/lib32/libvlc/vlc/plugins")
this.libavutil_ptr = DyLibLoad(exepath()+"/lib32/libavutil.so.55")
this.libswscale_ptr = DyLibLoad(exepath()+"/lib32/libswscale.so.4")
this.libvlccore_ptr = DyLibLoad(exepath()+"/lib32/libvlc/libvlccore.so.9")
this.libvlc_ptr = DyLibLoad(exepath()+"/lib32/libvlc/libvlc.so")
#endif
end if
#endIf
' ERROR loading libvlc
if this.libvlc_ptr=0 then
print "Could not load libvlc. Video playback will not work."
end 1
end if
'get procedure pointers
libvlc_get_version=DyLibSymbol(this.libvlc_ptr,"libvlc_get_version")
libvlc_new =DyLibSymbol(this.libvlc_ptr,"libvlc_new")
libvlc_release=DyLibSymbol(this.libvlc_ptr,"libvlc_release")
libvlc_media_new_location=DyLibSymbol(this.libvlc_ptr,"libvlc_media_new_location")
libvlc_media_new_path=DyLibSymbol(this.libvlc_ptr,"libvlc_media_new_path")
libvlc_media_player_new_from_media=DyLibSymbol(this.libvlc_ptr,"libvlc_media_player_new_from_media")
libvlc_media_release=DyLibSymbol(this.libvlc_ptr,"libvlc_media_release")
libvlc_media_player_set_hwnd=DyLibSymbol(this.libvlc_ptr,"libvlc_media_player_set_hwnd")
libvlc_media_player_set_xwindow=DyLibSymbol(this.libvlc_ptr,"libvlc_media_player_set_xwindow")
libvlc_media_player_play=DyLibSymbol(this.libvlc_ptr,"libvlc_media_player_play")
libvlc_media_player_release=DyLibSymbol(this.libvlc_ptr,"libvlc_media_player_release")
libvlc_media_player_stop=DyLibSymbol(this.libvlc_ptr,"libvlc_media_player_stop")
libvlc_audio_set_volume=DyLibSymbol(this.libvlc_ptr,"libvlc_audio_set_volume")
libvlc_media_player_get_length=DyLibSymbol(this.libvlc_ptr,"libvlc_media_player_get_length")
libvlc_media_player_get_time=DyLibSymbol(this.libvlc_ptr,"libvlc_media_player_get_time")
libvlc_media_player_get_position=DyLibSymbol(this.libvlc_ptr,"libvlc_media_player_get_position")
libvlc_video_set_marquee_string=DyLibSymbol(this.libvlc_ptr,"libvlc_video_set_marquee_string")
libvlc_video_set_marquee_int=DyLibSymbol(this.libvlc_ptr,"libvlc_video_set_marquee_string")
libvlc_media_player_is_playing=DyLibSymbol(this.libvlc_ptr,"libvlc_media_player_is_playing")
libvlc_set_fullscreen=DyLibSymbol(this.libvlc_ptr,"libvlc_set_fullscreen")
libvlc_video_set_key_input=DyLibSymbol(this.libvlc_ptr,"libvlc_video_set_key_input")
libvlc_media_player_get_state=DyLibSymbol(this.libvlc_ptr,"libvlc_media_player_get_state")
libvlc_video_set_format=DyLibSymbol(this.libvlc_ptr,"libvlc_video_set_format")
libvlc_video_set_callbacks=DyLibSymbol(this.libvlc_ptr,"libvlc_video_set_callbacks")
'vlc command-line parameters
Dim As Any Ptr vlc_args(0 To ...) = { @"--no-xlib", _
@"--quiet" }
' Dim As Any Ptr vlc_args(0 To ...) = { @"--no-xlib", _
' @"-vvv", _
' @"--ignore-config", _
' @"--quiet", _
'create vlc instance
this.instance = libvlc_new (UBound(vlc_args) + 1, @vlc_args(0))
'get screen/image info
if this.internal_image=0 then ' we use the screen
screeninfo this.xsize, this.ysize, , , this.pitch
else ' we use an image
'ImageInfo( image [, [width] [, [height] [, [bypp] [, [pitch] [, [pixdata] [, size]]]]]] )
imageinfo this.internal_image, this.xsize, this.ysize, , this.pitch
end if
this.started=true 'it's started!
end sub
function libvlc_lockCB cdecl(byval image as any ptr, byval pPlanes as any ptr ptr) as any ptr 'lock callback
if image=0 then
' no image : lock and get the address of the screen pixel buffer
screenlock
pPlanes[0]=screenptr()
else
' lock and use image get the address of the pixel buffer
mutexlock(fbvlc.vlcmutex)
Imageinfo(image,,,,,pPlanes[0])
end if
return 0
end function
sub libvlc_unlockCB cdecl(byval image as any ptr, byval pPicture as any ptr, byval pPlanes as any const ptr ptr) 'unlock callback
if image=0 then
'no image : unlock screen
screenunlock
else
'unlock image
mutexunlock(fbvlc.vlcmutex)
end if
end sub
sub libvlc_displayCB cdecl(byval image as any ptr, byval pPicture as any ptr) 'display callback - unused
'UNUSED
'if image=0 then return
end sub
sub fbvlctype.sync() 'update fbvlc.image
mutexlock(this.vlcmutex)
put this.image, (0,0), this.internal_image, pset 'update image buffer
mutexunlock(this.vlcmutex)
this.playerState = libvlc_media_player_get_state(this.player) 'update libvlc state
if this.playerState=libvlc_Ended then this.videoEnded=true 'check if video ended
end sub
sub fbvlctype.drawToScreen()
#ifdef use_opengl
'render using OpenGL
gl_Put(0,0,this.image)
glFinish()
#else
'render using fbgfx
put (0,0),this.image,PSET
#endif
end sub
sub fbvlctype.load(byval filename as string) 'load video file
if this.started=false then this.init() 'init if not already started
if filename="" then filename=dir("*.ogv") 'search .ogv files
if filename="" then exit sub 'none found - exit
this.unload()
this.videoEnded=false
this.media = libvlc_media_new_path(this.instance, strptr(filename)) 'load media
this.player = libvlc_media_player_new_from_media(this.media) 'create player
if this.media then
libvlc_media_release(this.media) 'release media as it's no longer needed
this.media=0
end if
libvlc_video_set_format(this.player, @"BGRA", this.xsize, this.ysize, this.pitch) 'set image parameters
'libvlc_video_set_callbacks(fbvlc.player, @libvlc_lockCB, @libvlc_unlockCB, @libvlc_displayCB, fbvlc.internal_image)
libvlc_video_set_callbacks(this.player, @libvlc_lockCB, @libvlc_unlockCB, 0, this.internal_image) 'configure callbacks
' start the video/audio decoder stream
var result = libvlc_media_player_play(this.player) 'play!
if (result<>0) then
'ERROR!
print "libvlc_media_player_play returned an error!"
libvlc_media_player_release(this.player) 'release media
libvlc_release(this.instance) 'release instance
exit sub 'leave
end if
end sub
sub fbvlctype.setVolume(byval volume as integer) 'set audio volume
libvlc_audio_set_volume(this.player, volume)
end sub
sub fbvlctype.unload() 'stop and clear
if this.player then
libvlc_media_player_stop(this.player) 'stop player
libvlc_media_player_release(this.player) 'close player
this.player=0
end if
this.videoEnded=true
end sub
sub fbvlctype.playVideoFile(byval filename as string, byval volume as integer) 'simple procedure to play videos
if this.started=false then this.init() 'init if not already started
this.load(filename) 'load video
this.setVolume(volume) 'set volume
do
screensync() 'wait sync rate interval
flip() 'swap buffers
this.sync() 'update image buffer
this.drawToScreen() 'render to screen
loop until multikey(1)=true or this.videoEnded=true 'wait for ESC or video ended
this.unload()
end sub
sub fbvlctype.finish() 'finish libvlc
libvlc_release(this.instance) 'close vlc instance
if fbvlc.libavutil_ptr then dylibfree(fbvlc.libavutil_ptr)
if fbvlc.libswscale_ptr then dylibfree(fbvlc.libswscale_ptr)
if fbvlc.libvlccore_ptr then dylibfree(fbvlc.libvlccore_ptr)
if fbvlc.libvlc_ptr then dylibfree(fbvlc.libvlc_ptr)
end sub
' ------------------------------------------------------------------
' simple example:
chdir exepath() 'set the working dir to the exe dir
initScreen(1280,800,0,60) 'set video mode
fbvlc.init() 'init fbvlc
fbvlc.playVideoFile("./small.ogv",100) 'play a video
sleep 200,1
fbvlc.playVideoFile("./sample.ogv",100) 'play a video
sleep 200,1
fbvlc.finish() 'finish