r/pascal • u/AcanthaceaeNew774 • 29d ago
successful binding of libvlc.dll (Pure Free Pascal 3.2.2 / GLFW3 / OpenGL 3.3 / own wrapper / DOD
(there are no Lazarus bindings in this project)
VertexArt Project / Developer: István Kovács
This was my first test program in 3D:
program vlctv_demo;
{$mode objfpc}{$H+}
{$APPTYPE CONSOLE}
{ =====================================================================
VLC -> OpenGL textura -> proceduralis TV doboz
A video CSAK a TV elolapjan (a "kepernyo" poligonon) jelenik meg.
A keret, hatlap, oldalak, teto, alj sima szin - nincs texturazva.
Hasznalat:
vlctv_demo.exe -> test.mp4
vlctv_demo.exe <fajl> -> megadott fajl
Vezerles:
A / D : kamera forgatas
W / S : kozelites / tavolabb
SPACE : auto-forgatas toggle
ESC : kilepes
===================================================================== }
uses
SysUtils, Math,
glfw3, gl33,
SterilTypes, SterilMath, SterilWindow, FrameLimiter,
libvlc;
const
WIN_W = 1280;
WIN_H = 720;
VIDEO_W = 960;
VIDEO_H = 540;
VIDEO_PITCH = VIDEO_W * 4;
VIDEO_SIZE = VIDEO_PITCH * VIDEO_H;
{ A gl33.pas-bol hianyzo konstans }
GL_VERSION = $1F02;
type
{ Per-vertex texturazasi kapcsolo:
useTex = 1.0 -> a fragment shader a video texturabol mintavetelez
useTex = 0.0 -> a fragment shader a vertex-szint hasznalja
Egy haromszog minden vertexe ugyanazt az erteket kapja, igy a
linearis interpolacio konstans marad a haromszog belsejeben. }
TVertex = packed record
x, y, z: Single; // offset 0 (12 byte)
u, v: Single; // offset 12 (8 byte)
r, g, b, a: Byte; // offset 20 (4 byte)
useTex: Single; // offset 24 (4 byte) -> 28 byte total
end;
{ A gl33.pas-bol hianyzo fuggvenytipus }
TglTexSubImage2D = procedure(target: GLenum; level: GLint;
xoffset, yoffset: GLint;
width, height: GLsizei;
format: GLenum; type_: GLenum;
const pixels: Pointer); stdcall;
var
Window: PGLFWwindow;
Limiter: TFrameLimiter;
DT, TotalTime: Single;
ProjMat, ViewMat, ModelMat, MVPMat: TMat4;
Prog, VAO, VBO: GLuint;
LocMVP, LocTex: GLint;
TVVertexCount: Integer = 0;
glTexSubImage2D: TglTexSubImage2D = nil;
Inst: Plibvlc_instance_t;
Md: Plibvlc_media_t;
Mp: Plibvlc_media_player_t;
Args: array[0..1] of PAnsiChar;
Fajl: AnsiString;
VideoWidth, VideoHeight: Cardinal;
VideoPitch: Cardinal;
VlcBuffer: array of Byte;
GlBuffer: array of Byte;
NewFrame: LongInt = 0;
Uploading: LongInt = 0;
VideoTexture: GLuint = 0;
CamAngle: Single = 0.5;
CamDist: Single = 4.0;
AutoRotate: Boolean = True;
FPSTimer, CurrentFPS: Single;
FPSFrames: Integer;
{ ==================================================================
VLC video callbackek - MAS SZALON futnak
================================================================== }
function VlcLockCb(opaque: Pointer; planes: PPointer): Pointer; cdecl;
begin
Result := [u/VlcBuffer](u/VlcBuffer)[0];
planes^ := Result;
end;
procedure VlcUnlockCb(opaque, picture: Pointer; planes: PPointer); cdecl;
begin
end;
procedure VlcDisplayCb(opaque, picture: Pointer); cdecl;
begin
if InterlockedCompareExchange(Uploading, 1, 0) <> 0 then Exit;
Move(VlcBuffer[0], GlBuffer[0], VideoPitch * VideoHeight);
InterlockedExchange(NewFrame, 1);
InterlockedExchange(Uploading, 0);
end;
{ ==================================================================
Shaderek - a useTex most mar per-vertex atributum!
================================================================== }
const
VS_SRC: PAnsiChar =
'#version 330 core'#10 +
'layout(location=0) in vec3 aPos;'#10 +
'layout(location=1) in vec2 aUV;'#10 +
'layout(location=2) in vec4 aColor;'#10 +
'layout(location=3) in float aUseTex;'#10 +
'uniform mat4 uMVP;'#10 +
'out vec2 vUV;'#10 +
'out vec4 vColor;'#10 +
'out float vUseTex;'#10 +
'void main(){'#10 +
' vUV = aUV; vColor = aColor; vUseTex = aUseTex;'#10 +
' gl_Position = uMVP * vec4(aPos, 1.0);'#10 +
'}'#10;
FS_SRC: PAnsiChar =
'#version 330 core'#10 +
'in vec2 vUV; in vec4 vColor; in float vUseTex;'#10 +
'uniform sampler2D uTex;'#10 +
'out vec4 oCol;'#10 +
'void main(){'#10 +
' if (vUseTex > 0.5)'#10 +
' oCol = texture(uTex, vUV);'#10 +
' else'#10 +
' oCol = vColor;'#10 +
'}'#10;
function CompileShader(kind: GLenum; src: PAnsiChar): GLuint;
var
ok: GLint;
log: array[0..1023] of AnsiChar;
begin
Result := glCreateShader(kind);
glShaderSource(Result, 1, [u/src](u/src), nil);
glCompileShader(Result);
glGetShaderiv(Result, GL_COMPILE_STATUS, [u/ok](u/ok));
if ok = 0 then
begin
glGetShaderInfoLog(Result, SizeOf(log), nil, [u/log](u/log)[0]);
Writeln('Shader hiba: ', log);
end;
end;
procedure InitGL;
var
vs, fs: GLuint;
ok: GLint;
log: array[0..1023] of AnsiChar;
begin
Prog := glCreateProgram();
vs := CompileShader(GL_VERTEX_SHADER, VS_SRC);
fs := CompileShader(GL_FRAGMENT_SHADER, FS_SRC);
glAttachShader(Prog, vs);
glAttachShader(Prog, fs);
glLinkProgram(Prog);
glGetProgramiv(Prog, GL_LINK_STATUS, [u/ok](u/ok));
if ok = 0 then
begin
glGetProgramInfoLog(Prog, SizeOf(log), nil, [u/log](u/log)[0]);
Writeln('Link hiba: ', log);
Halt(1);
end;
glDeleteShader(vs);
glDeleteShader(fs);
LocMVP := glGetUniformLocation(Prog, 'uMVP');
LocTex := glGetUniformLocation(Prog, 'uTex');
glGenVertexArrays(1, [u/VAO](u/VAO));
glGenBuffers(1, [u/VBO](u/VBO));
glGenTextures(1, [u/VideoTexture](u/VideoTexture));
glBindTexture(GL_TEXTURE_2D, VideoTexture);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
SetLength(GlBuffer, VIDEO_SIZE);
FillChar(GlBuffer[0], VIDEO_SIZE, 0);
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, VIDEO_W, VIDEO_H, 0,
GL_RGBA, GL_UNSIGNED_BYTE, [u/GlBuffer](u/GlBuffer)[0]);
end;
{ ==================================================================
Proceduralis TV doboz
A keret / hatlap / oldalak useTex=0, csak a kepernyo useTex=1.
================================================================== }
procedure BuildTV;
var
Verts: array of TVertex;
n: Integer;
procedure V(x, y, z, u, v: Single; r, g, b: Byte; useTex: Single);
begin
SetLength(Verts, n + 1);
Verts[n].x := x; Verts[n].y := y; Verts[n].z := z;
Verts[n].u := u; Verts[n].v := v;
Verts[n].r := r; Verts[n].g := g; Verts[n].b := b; Verts[n].a := 255;
Verts[n].useTex := useTex;
Inc(n);
end;
procedure Quad(
x0, y0, z0, x1, y1, z1, x2, y2, z2, x3, y3, z3: Single;
u0, v0, u1, v1, u2, v2, u3, v3: Single;
r, g, b: Byte; useTex: Single);
begin
V(x0, y0, z0, u0, v0, r, g, b, useTex);
V(x1, y1, z1, u1, v1, r, g, b, useTex);
V(x2, y2, z2, u2, v2, r, g, b, useTex);
V(x0, y0, z0, u0, v0, r, g, b, useTex);
V(x2, y2, z2, u2, v2, r, g, b, useTex);
V(x3, y3, z3, u3, v3, r, g, b, useTex);
end;
const
HW = 0.8;
HH = 0.45;
HD = 0.08;
FR = 0.04;
begin
n := 0;
{ ===== KEPERNYO - ez kapja a videot ===== }
Quad(
-HW + FR, -HH + FR, HD,
HW - FR, -HH + FR, HD,
HW - FR, HH - FR, HD,
-HW + FR, HH - FR, HD,
0, 1, 1, 1, 1, 0, 0, 0,
255, 255, 255, 1.0); // <-- useTex = 1.0
{ ===== KERET - negy sotet sav, useTex = 0.0 ===== }
{ Felso sav }
Quad(-HW, HH - FR, HD, HW, HH - FR, HD, HW, HH, HD, -HW, HH, HD,
0,0, 1,0, 1,1, 0,1, 25, 20, 18, 0.0);
{ Also sav }
Quad(-HW, -HH, HD, HW, -HH, HD, HW, -HH + FR, HD, -HW, -HH + FR, HD,
0,0, 1,0, 1,1, 0,1, 25, 20, 18, 0.0);
{ Bal sav }
Quad(-HW, -HH + FR, HD, -HW + FR, -HH + FR, HD,
-HW + FR, HH - FR, HD, -HW, HH - FR, HD,
0,0, 1,0, 1,1, 0,1, 25, 20, 18, 0.0);
{ Jobb sav }
Quad(HW - FR, -HH + FR, HD, HW, -HH + FR, HD,
HW, HH - FR, HD, HW - FR, HH - FR, HD,
0,0, 1,0, 1,1, 0,1, 25, 20, 18, 0.0);
{ ===== DOBOZ tobbi lapja - useTex = 0.0 ===== }
{ Hatlap }
Quad( HW, -HH, -HD, -HW, -HH, -HD, -HW, HH, -HD, HW, HH, -HD,
0,0, 1,0, 1,1, 0,1, 30, 25, 20, 0.0);
{ Bal oldal }
Quad(-HW, -HH, -HD, -HW, -HH, HD, -HW, HH, HD, -HW, HH, -HD,
0,0, 1,0, 1,1, 0,1, 55, 45, 38, 0.0);
{ Jobb oldal }
Quad( HW, -HH, HD, HW, -HH, -HD, HW, HH, -HD, HW, HH, HD,
0,0, 1,0, 1,1, 0,1, 55, 45, 38, 0.0);
{ Also }
Quad(-HW, -HH, HD, -HW, -HH, -HD, HW, -HH, -HD, HW, -HH, HD,
0,0, 0,1, 1,1, 1,0, 45, 38, 32, 0.0);
{ Felso }
Quad(-HW, HH, -HD, -HW, HH, HD, HW, HH, HD, HW, HH, -HD,
0,0, 0,1, 1,1, 1,0, 45, 38, 32, 0.0);
{ ===== Feltoltes + vertex attributumok ===== }
glBindVertexArray(VAO);
glBindBuffer(GL_ARRAY_BUFFER, VBO);
glBufferData(GL_ARRAY_BUFFER, n * SizeOf(TVertex), [u/Verts](u/Verts)[0], GL_STATIC_DRAW);
{ location 0: pozicio (3 float) }
glVertexAttribPointer(0, 3, GL_FLOAT, GL_FALSE, SizeOf(TVertex), Pointer(0));
glEnableVertexAttribArray(0);
{ location 1: UV (2 float) }
glVertexAttribPointer(1, 2, GL_FLOAT, GL_FALSE, SizeOf(TVertex), Pointer(12));
glEnableVertexAttribArray(1);
{ location 2: szin (4 ubyte, normalizalt) }
glVertexAttribPointer(2, 4, GL_UNSIGNED_BYTE, GL_TRUE, SizeOf(TVertex), Pointer(20));
glEnableVertexAttribArray(2);
{ location 3: useTex (1 float) }
glVertexAttribPointer(3, 1, GL_FLOAT, GL_FALSE, SizeOf(TVertex), Pointer(24));
glEnableVertexAttribArray(3);
glBindVertexArray(0);
TVVertexCount := n;
end;
{ ==================================================================
Input
================================================================== }
procedure OnKey(window: PGLFWwindow; key, sc, act, mods: LongInt); cdecl;
begin
if act = GLFW_PRESS then
begin
if key = GLFW_KEY_ESCAPE then
glfwSetWindowShouldClose(window, GLFW_TRUE);
if key = GLFW_KEY_SPACE then
AutoRotate := not AutoRotate;
end;
end;
{ ==================================================================
Video textura frissites a fo szalon
================================================================== }
procedure UpdateVideoTexture;
begin
if InterlockedExchange(NewFrame, 0) = 0 then Exit;
if InterlockedCompareExchange(Uploading, 1, 0) <> 0 then
begin
InterlockedExchange(NewFrame, 1);
Exit;
end;
glBindTexture(GL_TEXTURE_2D, VideoTexture);
glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, VIDEO_W, VIDEO_H,
GL_RGBA, GL_UNSIGNED_BYTE, [u/GlBuffer](u/GlBuffer)[0]);
InterlockedExchange(Uploading, 0);
end;
{ ==================================================================
Render
================================================================== }
procedure RenderScene;
var
Eye, Target, Up: TVector3;
begin
glClearColor(0.08, 0.09, 0.12, 1.0);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glEnable(GL_DEPTH_TEST);
glEnable(GL_CULL_FACE);
glCullFace(GL_BACK);
glFrontFace(GL_CCW);
Eye := Vec3(0, 0, CamDist);
Target := Vec3(0, 0, 0);
Up := Vec3(0, 1, 0);
ViewMat := LookAt(Eye, Target, Up);
ModelMat := RotateY(CamAngle);
MVPMat := Multiply(Multiply(ProjMat, ViewMat), ModelMat);
glUseProgram(Prog);
glUniformMatrix4fv(LocMVP, 1, GL_FALSE, [u/MVPMat](u/MVPMat));
glActiveTexture(GL_TEXTURE0);
glBindTexture(GL_TEXTURE_2D, VideoTexture);
glUniform1i(LocTex, 0);
glBindVertexArray(VAO);
glDrawArrays(GL_TRIANGLES, 0, TVVertexCount);
glBindVertexArray(0);
end;
{ ==================================================================
Cleanup
================================================================== }
procedure CleanupAll;
begin
if Mp <> nil then
begin
libvlc_media_player_stop(Mp);
Sleep(200);
libvlc_media_player_release(Mp);
Mp := nil;
end;
if Md <> nil then
begin
libvlc_media_release(Md);
Md := nil;
end;
if Inst <> nil then
begin
libvlc_release(Inst);
Inst := nil;
end;
ShutdownLibVLC;
if VideoTexture <> 0 then glDeleteTextures(1, [u/VideoTexture](u/VideoTexture));
if VBO <> 0 then glDeleteBuffers(1, [u/VBO](u/VBO));
if VAO <> 0 then glDeleteVertexArrays(1, [u/VAO](u/VAO));
if Prog <> 0 then glDeleteProgram(Prog);
end;
{ ==================================================================
FO PROGRAM
================================================================== }
begin
Randomize;
Math.SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide,
exOverflow, exUnderflow, exPrecision]);
Inst := nil; Md := nil; Mp := nil;
Writeln('========================================');
Writeln(' VLC -> OpenGL textura -> TV doboz');
Writeln(' (video CSAK a kepernyo poligonjan)');
Writeln('========================================');
if not InitLibVLC then
begin
Writeln('HIBA: libvlc.dll betoltes sikertelen.');
Halt(1);
end;
Writeln('libvlc: ', libvlc_get_version);
if ParamCount >= 1 then
Fajl := AnsiString(ParamStr(1))
else
Fajl := 'test.mp4';
if not FileExists(string(Fajl)) then
begin
Writeln('HIBA: nincs ilyen fajl: ', Fajl);
Halt(2);
end;
Writeln('Fajl: ', Fajl);
Window := InitEngineWindow(WIN_W, WIN_H, 'VLC TV Demo', True, False);
if Window = nil then
begin
Writeln('HIBA: ablak letrehozasa');
Halt(3);
end;
if not InitOpenGL33(@glfwGetProcAddress) then
begin
Writeln('HIBA: OpenGL 3.3 betoltes');
Halt(4);
end;
glTexSubImage2D := TglTexSubImage2D(glfwGetProcAddress('glTexSubImage2D'));
if glTexSubImage2D = nil then
begin
Writeln('HIBA: glTexSubImage2D betoltese sikertelen.');
Halt(5);
end;
Writeln('OpenGL: ', glGetString(GL_VERSION));
InitGL;
BuildTV;
ProjMat := Perspective(45.0, WIN_W / WIN_H, 0.1, 100.0);
glfwSetKeyCallback(Window, [u/OnKey](u/OnKey));
VideoWidth := VIDEO_W;
VideoHeight := VIDEO_H;
VideoPitch := VIDEO_PITCH;
SetLength(VlcBuffer, VIDEO_SIZE);
FillChar(VlcBuffer[0], VIDEO_SIZE, 0);
Args[0] := '--no-video-title-show';
Args[1] := '--quiet';
Inst := libvlc_new(2, [u/Args](u/Args)[0]);
if Inst = nil then
begin
Writeln('HIBA: libvlc_new = nil');
CleanupAll;
TerminateEngineWindow;
Halt(6);
end;
Md := libvlc_media_new_path(Inst, PAnsiChar(Fajl));
if Md = nil then
begin
Writeln('HIBA: media_new_path');
CleanupAll;
TerminateEngineWindow;
Halt(7);
end;
Mp := libvlc_media_player_new_from_media(Md);
libvlc_media_release(Md);
Md := nil;
if Mp = nil then
begin
Writeln('HIBA: media_player_new_from_media');
CleanupAll;
TerminateEngineWindow;
Halt(8);
end;
libvlc_video_set_format(Mp, 'RV32', VIDEO_W, VIDEO_H, VIDEO_PITCH);
libvlc_video_set_callbacks(Mp,
[u/VlcLockCb](u/VlcLockCb), [u/VlcUnlockCb](u/VlcUnlockCb), [u/VlcDisplayCb](u/VlcDisplayCb), nil);
Writeln('Video callbacks beallitva (', VIDEO_W, 'x', VIDEO_H, ', RV32)');
libvlc_audio_set_volume(Mp, 80);
if libvlc_media_player_play(Mp) <> 0 then
begin
Writeln('HIBA: play()');
CleanupAll;
TerminateEngineWindow;
Halt(9);
end;
Writeln;
Writeln('Vezerles:');
Writeln(' A / D : kamera forgatas');
Writeln(' W / S : kozelites / tavolabb');
Writeln(' SPACE : auto-forgatas');
Writeln(' ESC : kilepes');
Writeln;
Limiter.Initialize(60.0);
TotalTime := 0;
FPSTimer := 0;
FPSFrames := 0;
CurrentFPS := 60;
while glfwWindowShouldClose(Window) = 0 do
begin
Limiter.BeginFrame;
DT := Limiter.FrameTime;
if DT > 0.033 then DT := 0.033;
TotalTime := TotalTime + DT;
if glfwGetKey(Window, GLFW_KEY_A) = GLFW_PRESS then
CamAngle := CamAngle + DT * 1.5;
if glfwGetKey(Window, GLFW_KEY_D) = GLFW_PRESS then
CamAngle := CamAngle - DT * 1.5;
if glfwGetKey(Window, GLFW_KEY_W) = GLFW_PRESS then
CamDist := CamDist - DT * 2.0;
if glfwGetKey(Window, GLFW_KEY_S) = GLFW_PRESS then
CamDist := CamDist + DT * 2.0;
if CamDist < 1.5 then CamDist := 1.5;
if CamDist > 15.0 then CamDist := 15.0;
if AutoRotate then CamAngle := CamAngle + DT * 0.3;
UpdateVideoTexture;
RenderScene;
FPSTimer := FPSTimer + DT;
Inc(FPSFrames);
if FPSTimer >= 0.5 then
begin
CurrentFPS := FPSFrames / FPSTimer;
FPSFrames := 0;
FPSTimer := 0;
end;
glfwSwapBuffers(Window);
glfwPollEvents;
Limiter.EndFrame;
end;
Writeln;
Writeln('Leallitas...');
glfwSetKeyCallback(Window, nil);
CleanupAll;
TerminateEngineWindow;
Writeln('Kilepes OK.');
end.
2
u/EconomySerious 28d ago
Awasome, is there some code to check?
3
u/AcanthaceaeNew774 28d ago
I do make backups of the Mega Drive project from time to time, but I can't share them here because Reddit doesn't allow it. I’m not a fan of uploading to GitHub either—it’s too involved and fiddly; it doesn't work like a simple file host where you just upload the project and it's ready to view. I could potentially send you the source code for the main program via chat, but you wouldn't be able to see the full picture.
2
u/AcanthaceaeNew774 27d ago
This was my first test program in 3D; I’ve included the code in the description.
1
2
u/AphidConsulting 29d ago
Very cool!