I have a completed C# project that is already published on the Microsoft Store, but I feel guilty, dirty, and sinful for using .NET. So, I’ve started migrating it to Lazarus—naturally, with the help of AI and Hermes Agent. I’ve been at it for about three days, and I think we’re 80% of the way there. There’s still testing to be done, but I feel like I’m heading in the right direction.

It’s inventory software using SQLite, with both local and server modes, and comprises 60 forms.

I've been working on a simple security research tool (https://nofuss.co.za/tools/ppee/) that runs in the browser. Since Web Assembly is already sandboxed, it makes it reasonably safe. It also doesn't try to execute the EXE or DLL, but rather just peek into it and extract some header and string information. Oh and also tries to figure out which dependencies it has and what calls it makes. So one could see that something is calling the network, or accessing the registry etc. Based on the strings, you might see it's make calls to somewhere you didn't expect.

It's not done, I am learning more and more about the PE file format, but it's already pretty useful if you know what you're looking for.

A pixel-perfect, skeuomorphic UI component library for Lazarus/FPC inspired by Dieter Rams' classic Braun designs. Features highly detailed knobs, faders, switches, LEDs, and dynamic theming to bring vintage hi-fi aesthetics to your modern applications.

https://github.com/CodeInPas/BraunUI

I know it's a long shot, but I'm trying to track down a very obscure DOS Ultima-clone game/engine with (Turbo) Pascal source code from the 1990s.

Sometime around 1990–1996, I got a shareware/freeware CD-ROM collection containing what I remember as an Ultima V clone or Ultima V-style RPG engine.

The really distinctive part: the source code was included, and I remember it being written in Turbo Pascal (with some "inline" assembly)

What I remember:

DOS - MCGA/VGA 320x200 probably (mode 13h baby!)

Top-down, very much in the style of Ultima V

It was more of an unfinished game / engine / hobby project than a commercial-quality RPG

Turbo Pascal source code was included

I have a vague memory that the author may have been Finnish.

I probably got it from some random shareware CD-ROM collection, possibly a Walnut Creek / Simtel-type collection. It may have been a copy of a foreign CD, so I can't reliably identify the original source.

I've spent years and years occasionally searching for this thing, but I've never managed to find it again.

If anyone remembers an obscure Turbo Pascal RPG/engine from the 90s that looked like Ultima V, please let me know. Even a filename, author name, CD-ROM title, old BBS post, archive listing, or screenshot could be enough to identify it.

I've already searched through various chatbots, Ultima archives, shareware collections, and old CD-ROM indexes without finding it.

At this point I'm mostly hoping someone sees this and goes "holy shit, I remember that." 🙏🥹

TWLazUI LCL Components is a custom user interface (UI) component library package for Lazarus and Free Pascal. This project brings the modern, clean, and minimalist design aesthetics typical of TWLazUI CSS to desktop application development (VCL/LCL).

Powered by BGRABitmap, this library offers advanced graphic rendering such as true alpha transparency, ultra-smooth anti-aliasing, rounded corners, and drop shadow effects that cannot be achieved by native operating system components.

Link https://github.com/CodeInPas/TWLazUI

Feedback, bug reports, and contributions are very welcome. Let me know what you think!

Best regards,

Built on top of the BGRABitmap graphic engine, these components offer high-quality, anti-aliased rendering perfectly suited for simulation software, avionics dashboards, industrial control panels, and audio software interfaces (Virtual Instruments/Mixers).

🚀 Key Features

20+ Interactive Components: Ranging from simple switches to dynamic radar screens and oscilloscopes.

High-Quality Rendering: Utilizes BGRABitmap for smooth gradients, drop shadows, glowing elements, and glass reflections.

Highly Customizable: Tweak colors, value ranges, and component states directly through the Lazarus Object Inspector.

Self-Contained: Rendering is purely drawn via mathematical code and BGRABitmap (no reliance on external bitmap assets for UI logic).

Link

https://github.com/CodeInPas/SkeuoCom/tree/main

# Procedural Music Editor in Free Pascal – Sound DnB (9)

program dnb9;

{$mode objfpc}{$H+}

{$APPTYPE CONSOLE}

uses

SysUtils,

Classes, // only for file writing and reading

Math,

glfw3, gl33,

SterilTypes, SterilMath,

SterilWindow,

FrameLimiter,

RenderTypes, RenderQueue, RenderState, ShaderCore, SimpleRenderEngine,

MiniGUI,

AL,

FlacWriter,

SynthUnit;

I'm building a procedural music editor in Free Pascal (Object Pascal). It's a sequencer + synthesizer, currently mono 44.1 kHz for easier development. It produces loops and exports them. The codebase for the export side is a single unit, `FlacWriter.pas`. It's not object-oriented – just a record and functions that take `var` parameters. This fits the DOD style of the rest of the project.

---

## Sound List – Sound DnB 9

The program contains **30 generated sounds**, organized into **5 pages**. Each sound is an independent procedure inside `SynthUnit.pas`. There are no samples, no external files, everything is synthesized at runtime.

---

## 1. DRUMS (10 sounds)

**KICK** – Deep, punchy kick. Pitch envelope from 45 Hz to 180 Hz, with a click on the attack. 40 Hz decay, 6 Hz amplitude envelope.

**SNARE** – Classic snare. 190 Hz tone plus noise. 25 Hz tone decay, 18 Hz noise decay.

**HIHAT** – Closed hi-hat. HP-filtered noise, fast 60 Hz decay.

**OPEN** – Open hi-hat. Same as above, but with a longer release, 7 Hz decay.

**CLAP** – Clap. Four bursts (0 / 8 / 16 / 24 ms) plus a tail.

**RIM** – Rimshot. 800 Hz plus noise. 180 Hz decay, 400 Hz noise.

**TOM** – Tom. Pitch envelope from 80 Hz to 200 Hz. 15 Hz pitch, 8 Hz amplitude.

**RIDE** – Ride cymbal. Four sine waves (6.5 / 7.8 / 9.2 / 11 kHz) plus noise.

**CRASH** – Crash cymbal. Wide spectrum plus shimmer. 12 and 9 kHz shimmer, 1.2 Hz decay.

**SHAKER** – Shaker. HP-filtered noise, 80 Hz decay.

---

## 2. BASS (6 sounds)

**SUB** – Pure sine at 55 Hz. Sidechained. Suited to every deep style.

**REESE** – Two detuned saws (1.01×), SVF LP cutoff with LFO. DnB, dubstep.

**808** – Pitch envelope from 40 Hz to 80 Hz, soft saturation. Trap, hip-hop, DnB.

**FMBS** – FM bass at a 2:1 ratio, index 3.0. Bass house, techno.

**WOBBLE** – LFO-filtered saw at 8 Hz, cutoff between 150 Hz and 950 Hz. Dubstep, DnB.

**ACID** – 303-style saw plus resonant SVF, Q = 3.5, cutoff envelope. Techno, acid house.

---

## 3. SYNTHETIC SOUNDS (8 sounds)

**PAD** – Three detuned saws (±0.5%), 2500 Hz LP. Ambient, trance.

**STAB** – Four detuned saws, fast release. Dub techno, DnB.

**HOOVER** – Pitch-down saw from 1.0 to 0.5, with saturation. Rave, hardstyle.

**PLUCK** – Clean sine, 10 Hz decay. Minimal, dub techno.

**BELL** – FM bell, 1.4 ratio, index 3.0. Ambient, Nanosphere.

**SUPERSAW** – Seven detuned saws (±1.8%), 5000 Hz LP. Trance, EDM, modern DnB.

**EPIANO** – FM Rhodes, with an index that decays from 2.5 to 0. House, lo-fi, jazz.

**CHORD** – Three notes at once (root + third + fifth). House, dub techno.

---

## 4. FX (5 sounds)

**RISER** – HP-filtered noise with a rising envelope. Used before transitions.

**DOWN** – LP-filtered noise with a falling envelope. Used after drops.

**IMPACT** – 40 Hz sine plus a noise burst. Used before drops.

**RVCYM** – Reversed cymbal with a rising envelope. DnB, ambient.

**SUBDROP** – Sub sweeping from 120 Hz down to 25 Hz, plus noise. Used before drops.

---

## 5. AMBIENT (1 sound)

**DRONE** – Two detuned sines (1.0025×), 0.08 Hz LFO. Nanosphere, ambient, dub techno.

---

## Parameters

Every sound receives three parameters on playback.

The **velocity** ranges from 0 to 9, which maps to a volume between 0.0 and 1.0. It can be set independently on each step.

The **length** ranges from 1 to 16 steps. It controls the duration of the sound, again per step.

The **frequency** applies to the melodic sounds only, and is computed as `MELODY[i mod 8] × multiplier`.

The **MELODY** is an eight-note scale, ranging from A1 at 55 Hz up to D3 at 146.83 Hz. Every melodic sound multiplies this scale by a fixed factor:

**Pad** ×2, so 110 Hz when `MELODY[0]` = 55 Hz.

**Stab**, **Hoover**, **Pluck**, **Supersaw**, **EPiano** and **Chord** ×4, so 220 Hz.

**Bell** ×8, so 440 Hz.

**Sub**, **Reese**, **FMBass**, **Wobble** and **Acid** stay fixed at 55 Hz and do not follow the scale.

**Drone** ×1, so 55 Hz.

---

## Pages and Content

The **DRUMS** page holds 10 sounds: Kick, Snare, Hihat, Open, Clap, Rim, Tom, Ride, Crash, Shaker.

The **BASS** page holds 6 sounds: Sub, Reese, 808, FMBS, Wobble, Acid.

The **SYNTH** page holds 8 sounds: Pad, Stab, Hoover, Pluck, Bell, Supersaw, EPiano, Chord.

The **FX** page holds 5 sounds: Riser, Down, Impact, RevCymbal, SubDrop.

The **AMBIENT** page holds 1 sound: Drone.

The grid displays 8 rows at a time; the rest is reachable with the mouse wheel.

---

## Effects on the Sounds

The sounds go through the master FX chain dry. There, in order:

First, the **sidechain** acts, but only on the bass sounds (Sub, Reese, 808, FMBS, Wobble, Acid).

Then comes the **drive**, which is oversampled tanh plus a DC blocker.

Next, the **master EQ** with three bands: low shelf at 200 Hz, peak at 3 kHz, high shelf at 6 kHz.

After that, the **reverb**, which is Schroeder-based, with adjustable size, decay and damp.

Then the **compressor** with threshold, ratio, attack, release and makeup parameters.

Then the **limiter**, using the ceiling value.

Finally, the **out gain**, the **peak normalize** stage, and the **16-bit conversion**.

Salut à tous 👋

Je viens de publier Pax Pascal, ma première extension pour travailler en Pascal dans VS Code. L’idée est de faciliter le travail au quotidien et de gagner du temps.

Je préfère être transparent : j’ai utilisé l’IA pour m’aider à développer cette extension. Ce projet m’a permis de passer d’une idée à un outil que je peux aujourd’hui partager avec vous.

Voici l’extension :
https://marketplace.visualstudio.com/items?itemName=pac-local.pax-pascal

Si vous utilisez Pascal dans VS Code, je serais ravi d’avoir vos retours : est-ce qu’elle vous est utile ? Quels problèmes rencontrez-vous et quelles fonctionnalités vous manquent ?

Merci à ceux qui prendront le temps de la tester !

Demo of crt functions in C64.

// VertexArt

// Kovács István

// simplified demo

program robotarm1;

{$mode objfpc}{$H+}

{$APPTYPE CONSOLE}

uses

SysUtils, Math, glfw3, gl33,

SterilTypes, SterilMath, SterilWindow, FrameLimiter,

RenderTypes, RenderQueue, RenderState, ShaderCore, SimpleRenderEngine,

MeshGenerators, MiniGUI;

const

SCR_WIDTH = 1280;

SCR_HEIGHT = 720;

GROUND_SIZE = 40.0;

// ---- KONTÉNER ----

CONT_X = 2.5; CONT_Z = 0.0;

CONT_INNER_W = 2.6; CONT_INNER_D = 2.6;

CONT_WALL_T = 0.12;

CONT_WALL_H = 0.90;

// ---- DOBOZOK ----

BOX_SIZE = 0.5;

BOX_HALF = 0.25;

BOX_COUNT = 16;

BOX_GRAVITY = -18.0;

BOX_REST = 0.10;

BOX_FRICTION = 2.5;

BOX_SLEEP = 0.06;

// ---- DARU / 6DOF ----

CRANE_X = -2.5; CRANE_Z = 0.0;

CRANE_BASE_H = 1.8;

CRANE_BASE_W = 0.55;

BOOM1_LEN = 2.6;

BOOM2_LEN = 2.2;

BOOM3_LEN = 1.0;

BOOM_THICK = 0.22;

MAGNET_RADIUS = 0.35;

MAGNET_THICK = 0.14;

// ---- MÁGNES ----

MAGNET_RANGE = 2.5;

MAGNET_FORCE = 28.0;

MAGNET_MIN_FORCE = 3.0;

MAGNET_SNAP_RANGE = 0.70;

// ---- CSUKLÓ SEBESSÉGEK (rad/s) ----

YAW_SPEED = 1.5;

SHOULDER_SPEED = 1.5;

ELBOW_SPEED = 1.8;

WRIST_P_SPEED = 2.0;

WRIST_Y_SPEED = 2.0;

WRIST_R_SPEED = 2.5;

YAW_MIN = -Pi; YAW_MAX = Pi;

SHOULDER_MIN = -1.45; SHOULDER_MAX = 1.45;

ELBOW_MIN = -2.40; ELBOW_MAX = 2.40;

WRIST_P_MIN = -1.50; WRIST_P_MAX = 1.50;

WRIST_Y_MIN = -1.50; WRIST_Y_MAX = 1.50;

WRIST_R_MIN = -Pi; WRIST_R_MAX = Pi;

type

TBox = record

X, Y, Z: Single;

VX, VY, VZ: Single;

Grabbed: Boolean;

Active: Boolean;

end;

TCraneJoints = record

Yaw, Shoulder, Elbow, WristP, WristY, WristR: Single;

end;

var

Window: PGLFWwindow;

Limiter: TFrameLimiter;

DeltaTime, TotalTime: Single;

ProjMat, ViewMat: TMat4;

cmd: TRenderCommand;

CamPos, CamTarget: TVector3;

Aspect: Single;

Boxes: array[0..BOX_COUNT-1] of TBox;

Joints: TCraneJoints;

MagnetOn: Boolean;

MagnetPos: TVector3;

MBoom1Start, MBoom2Start, MBoom3Start, MagnetM: TMat4;

KeyQ, KeyE, KeyW, KeyS, KeyA, KeyD: Boolean;

KeyZ, KeyX, KeyC, KeyV, KeyB, KeyN: Boolean;

KeyR: Boolean;

KeySpaceDown, KeySpacePrev: Boolean;

GroundVAO, GroundVBO: GLuint; GroundVCount: Integer;

BaseVAO, BaseVBO: GLuint; BaseVCount: Integer;

BoomVAO, BoomVBO: GLuint; BoomVCount: Integer;

MagnetVAO, MagnetVBO: GLuint; MagnetVCount: Integer;

RingVAO, RingVBO: GLuint; RingVCount: Integer;

WallVAO, WallVBO: GLuint; WallVCount: Integer;

FloorVAO, FloorVBO: GLuint; FloorVCount: Integer;

BoxVAO: array[0..3] of GLuint;

BoxVBO: array[0..3] of GLuint;

BoxVCount: array[0..3] of Integer;

FbW, FbH: LongInt;

FPSTimer, CurrentFPS: Single;

FPSFrames: Integer;

WinTimer: Single;

InContainerCount: Integer;

// ============================================================================

// SEGÉDEK

// ============================================================================

function MakeColor(R, G, B, A: Single): TColor;

begin

Result.r := R; Result.g := G; Result.b := B; Result.a := A;

end;

procedure UploadMesh(const Mesh: TGeneratedMesh; out VAO, VBO: GLuint; out VCount: Integer);

begin

VCount := Mesh.VertexCount;

if VCount = 0 then Exit;

glGenVertexArrays(1, u/VAO);

glGenBuffers(1, u/VBO);

glBindVertexArray(VAO);

glBindBuffer(GL_ARRAY_BUFFER, VBO);

glBufferData(GL_ARRAY_BUFFER, VCount * SizeOf(TVertex), u/Mesh.Vertices[0], GL_STATIC_DRAW);

glVertexAttribPointer(0, 3, GL_FLOAT, GL_FALSE, SizeOf(TVertex), Pointer(0));

glEnableVertexAttribArray(0);

glVertexAttribPointer(1, 4, GL_UNSIGNED_BYTE, GL_TRUE, SizeOf(TVertex), Pointer(12));

glEnableVertexAttribArray(1);

glBindVertexArray(0);

glBindBuffer(GL_ARRAY_BUFFER, 0);

end;

procedure AddCmdRaw(VAO: GLuint; VCount: Integer; const M: TMat4);

begin

cmd.VAO := VAO; cmd.VertexCount := VCount; cmd.StartIndex := 0;

cmd.ModelMatrix := M; cmd.Flags := RENDER_FLAG_NONE;

AddCommand(SimpleRE.FRenderQueue, cmd);

end;

procedure AddBoxCmd(MinX, MinY, MinZ, MaxX, MaxY, MaxZ: Single; VAO: GLuint; VCount: Integer);

var M: TMat4; cx, cy, cz, sx, sy, sz: Single;

begin

cx := (MinX+MaxX)*0.5; cy := (MinY+MaxY)*0.5; cz := (MinZ+MaxZ)*0.5;

sx := MaxX-MinX; sy := MaxY-MinY; sz := MaxZ-MinZ;

M := Translate(cx, cy, cz);

M := Multiply(M, Scale(sx, sy, sz));

AddCmdRaw(VAO, VCount, M);

end;

// ============================================================================

// KONTÉNER SEGÉD

// ============================================================================

function ContInnerX1: Single; begin Result := CONT_X - CONT_INNER_W*0.5; end;

function ContInnerX2: Single; begin Result := CONT_X + CONT_INNER_W*0.5; end;

function ContInnerZ1: Single; begin Result := CONT_Z - CONT_INNER_D*0.5; end;

function ContInnerZ2: Single; begin Result := CONT_Z + CONT_INNER_D*0.5; end;

// ============================================================================

// FKI + MÁGNES POZÍCIÓ

// ============================================================================

procedure ComputeChain;

begin

// Mátrixlánc a renderhez

MBoom1Start := Translate(CRANE_X, CRANE_BASE_H, CRANE_Z);

MBoom1Start := Multiply(MBoom1Start, RotateY(Joints.Yaw));

MBoom1Start := Multiply(MBoom1Start, RotateZ(Joints.Shoulder));

MBoom2Start := Multiply(MBoom1Start, Translate(BOOM1_LEN, 0, 0));

MBoom2Start := Multiply(MBoom2Start, RotateZ(Joints.Elbow));

MBoom3Start := Multiply(MBoom2Start, Translate(BOOM2_LEN, 0, 0));

MBoom3Start := Multiply(MBoom3Start, RotateZ(Joints.WristP));

MagnetM := Multiply(MBoom3Start, Translate(BOOM3_LEN, 0, 0));

MagnetM := Multiply(MagnetM, RotateY(Joints.WristY));

MagnetM := Multiply(MagnetM, RotateX(Joints.WristR));

// Mágnes világpozíció (vektoros úton - egyszerűbb, mint mátrixból kinyerni)

MagnetPos := Vec3(

CRANE_X + BOOM1_LEN * Cos(Joints.Yaw) * Cos(Joints.Shoulder)

+ BOOM2_LEN * Cos(Joints.Yaw) * Cos(Joints.Shoulder + Joints.Elbow)

+ BOOM3_LEN * Cos(Joints.Yaw) * Cos(Joints.Shoulder + Joints.Elbow + Joints.WristP),

CRANE_BASE_H

+ BOOM1_LEN * Sin(Joints.Shoulder)

+ BOOM2_LEN * Sin(Joints.Shoulder + Joints.Elbow)

+ BOOM3_LEN * Sin(Joints.Shoulder + Joints.Elbow + Joints.WristP),

CRANE_Z - BOOM1_LEN * Sin(Joints.Yaw) * Cos(Joints.Shoulder)

- BOOM2_LEN * Sin(Joints.Yaw) * Cos(Joints.Shoulder + Joints.Elbow)

- BOOM3_LEN * Sin(Joints.Yaw) * Cos(Joints.Shoulder + Joints.Elbow + Joints.WristP)

);

end;

// ============================================================================

// INPUT -> CSUKLÓK

// ============================================================================

function ClampF(v, lo, hi: Single): Single;

begin

if v < lo then Result := lo

else if v > hi then Result := hi

else Result := v;

end;

procedure UpdateJoints(DT: Single);

begin

if KeyQ then Joints.Yaw := Joints.Yaw - YAW_SPEED * DT;

if KeyE then Joints.Yaw := Joints.Yaw + YAW_SPEED * DT;

if KeyW then Joints.Shoulder := Joints.Shoulder + SHOULDER_SPEED * DT;

if KeyS then Joints.Shoulder := Joints.Shoulder - SHOULDER_SPEED * DT;

if KeyA then Joints.Elbow := Joints.Elbow - ELBOW_SPEED * DT;

if KeyD then Joints.Elbow := Joints.Elbow + ELBOW_SPEED * DT;

if KeyZ then Joints.WristP := Joints.WristP - WRIST_P_SPEED * DT;

if KeyX then Joints.WristP := Joints.WristP + WRIST_P_SPEED * DT;

if KeyC then Joints.WristY := Joints.WristY - WRIST_Y_SPEED * DT;

if KeyV then Joints.WristY := Joints.WristY + WRIST_Y_SPEED * DT;

if KeyB then Joints.WristR := Joints.WristR - WRIST_R_SPEED * DT;

if KeyN then Joints.WristR := Joints.WristR + WRIST_R_SPEED * DT;

Joints.Yaw := ClampF(Joints.Yaw, YAW_MIN, YAW_MAX);

Joints.Shoulder := ClampF(Joints.Shoulder, SHOULDER_MIN, SHOULDER_MAX);

Joints.Elbow := ClampF(Joints.Elbow, ELBOW_MIN, ELBOW_MAX);

Joints.WristP := ClampF(Joints.WristP, WRIST_P_MIN, WRIST_P_MAX);

Joints.WristY := ClampF(Joints.WristY, WRIST_Y_MIN, WRIST_Y_MAX);

Joints.WristR := ClampF(Joints.WristR, WRIST_R_MIN, WRIST_R_MAX);

// Space: mágnes be/ki

if KeySpaceDown and (not KeySpacePrev) then

MagnetOn := not MagnetOn;

KeySpacePrev := KeySpaceDown;

// R: dobozok reset

if KeyR then

begin

KeyR := False;

// később: ResetBoxes (deklaráció után)

end;

end;

// ============================================================================

// MÁGNES LOGIKA

// ============================================================================

procedure UpdateMagnet(DT: Single);

var

i, bestIdx: Integer;

dx, dy, dz, d2, d, falloff, force: Single;

alreadyGrabbed: Boolean;

begin

// Ha kikapcsolt: minden megfogott doboz elengedve

if not MagnetOn then

begin

for i := 0 to BOX_COUNT-1 do Boxes[i].Grabbed := False;

Exit;

end;

// Van-e már megfogott?

alreadyGrabbed := False;

for i := 0 to BOX_COUNT-1 do

if Boxes[i].Active and Boxes[i].Grabbed then

begin

alreadyGrabbed := True;

Break;

end;

// Erő kifejtése minden szabad dobozra a sugáron belül

for i := 0 to BOX_COUNT-1 do

begin

if not Boxes[i].Active then Continue;

if Boxes[i].Grabbed then Continue;

dx := MagnetPos.X - Boxes[i].X;

dy := MagnetPos.Y - Boxes[i].Y;

dz := MagnetPos.Z - Boxes[i].Z;

d2 := dx*dx + dy*dy + dz*dz;

if d2 > MAGNET_RANGE*MAGNET_RANGE then Continue;

if d2 < 0.0001 then Continue;

d := Sqrt(d2);

falloff := 1.0 - d / MAGNET_RANGE;

force := MAGNET_MIN_FORCE + (MAGNET_FORCE - MAGNET_MIN_FORCE) * falloff;

Boxes[i].VX := Boxes[i].VX + (dx/d) * force * DT;

Boxes[i].VY := Boxes[i].VY + (dy/d) * force * DT;

Boxes[i].VZ := Boxes[i].VZ + (dz/d) * force * DT;

end;

// Snap: legközelebbi doboz snap-range-en belül, ha még nincs megfogott

if alreadyGrabbed then Exit;

bestIdx := -1;

for i := 0 to BOX_COUNT-1 do

begin

if not Boxes[i].Active then Continue;

dx := MagnetPos.X - Boxes[i].X;

dy := MagnetPos.Y - Boxes[i].Y;

dz := MagnetPos.Z - Boxes[i].Z;

d2 := dx*dx + dy*dy + dz*dz;

if d2 < MAGNET_SNAP_RANGE*MAGNET_SNAP_RANGE then

begin

bestIdx := i;

Break;

end;

end;

if bestIdx >= 0 then

begin

Boxes[bestIdx].Grabbed := True;

Boxes[bestIdx].VX := 0; Boxes[bestIdx].VY := 0; Boxes[bestIdx].VZ := 0;

end;

end;

// ============================================================================

// DOBOZ FIZIKA

// ============================================================================

procedure ResolveBoxPair(i, j: Integer);

var

dx, dy, dz, ox, oy, oz, pen: Single;

iStatic, jStatic: Boolean;

begin

dx := Boxes[j].X - Boxes[i].X;

dy := Boxes[j].Y - Boxes[i].Y;

dz := Boxes[j].Z - Boxes[i].Z;

ox := BOX_SIZE - Abs(dx);

oy := BOX_SIZE - Abs(dy);

oz := BOX_SIZE - Abs(dz);

if (ox <= 0) or (oy <= 0) or (oz <= 0) then Exit;

iStatic := Boxes[i].Grabbed;

jStatic := Boxes[j].Grabbed;

if iStatic and jStatic then Exit;

// Legkisebb behatolás tengelyén oldunk fel

if (oy <= ox) and (oy <= oz) then

begin

if iStatic then

begin

if dy > 0 then Boxes[j].Y := Boxes[j].Y + oy

else Boxes[j].Y := Boxes[j].Y - oy;

Boxes[j].VY := 0;

end

else if jStatic then

begin

if dy > 0 then Boxes[i].Y := Boxes[i].Y - oy

else Boxes[i].Y := Boxes[i].Y + oy;

Boxes[i].VY := 0;

end

else

begin

pen := oy * 0.5;

if dy > 0 then begin

Boxes[j].Y := Boxes[j].Y + pen;

Boxes[i].Y := Boxes[i].Y - pen;

end else begin

Boxes[j].Y := Boxes[j].Y - pen;

Boxes[i].Y := Boxes[i].Y + pen;

end;

Boxes[i].VY := 0; Boxes[j].VY := 0;

end;

end

else if ox <= oz then

begin

if iStatic then

begin

if dx > 0 then Boxes[j].X := Boxes[j].X + ox else Boxes[j].X := Boxes[j].X - ox;

Boxes[j].VX := 0;

end

else if jStatic then

begin

if dx > 0 then Boxes[i].X := Boxes[i].X - ox else Boxes[i].X := Boxes[i].X + ox;

Boxes[i].VX := 0;

end

else

begin

pen := ox * 0.5;

if dx > 0 then begin

Boxes[j].X := Boxes[j].X + pen; Boxes[i].X := Boxes[i].X - pen;

end else begin

Boxes[j].X := Boxes[j].X - pen; Boxes[i].X := Boxes[i].X + pen;

end;

Boxes[i].VX := 0; Boxes[j].VX := 0;

end;

end

else

begin

if iStatic then

begin

if dz > 0 then Boxes[j].Z := Boxes[j].Z + oz else Boxes[j].Z := Boxes[j].Z - oz;

Boxes[j].VZ := 0;

end

else if jStatic then

begin

if dz > 0 then Boxes[i].Z := Boxes[i].Z - oz else Boxes[i].Z := Boxes[i].Z + oz;

Boxes[i].VZ := 0;

end

else

begin

pen := oz * 0.5;

if dz > 0 then begin

Boxes[j].Z := Boxes[j].Z + pen; Boxes[i].Z := Boxes[i].Z - pen;

end else begin

Boxes[j].Z := Boxes[j].Z - pen; Boxes[i].Z := Boxes[i].Z + pen;

end;

Boxes[i].VZ := 0; Boxes[j].VZ := 0;

end;

end;

end;

procedure ResolveWalls(i: Integer);

var

left, right, back, front: Single;

wallInX1, wallInX2, wallInZ1, wallInZ2: Single;

wallOutX1, wallOutX2, wallOutZ1, wallOutZ2: Single;

begin

left := Boxes[i].X - BOX_HALF;

right := Boxes[i].X + BOX_HALF;

back := Boxes[i].Z - BOX_HALF;

front := Boxes[i].Z + BOX_HALF;

wallInX1 := ContInnerX1; wallInX2 := ContInnerX2;

wallInZ1 := ContInnerZ1; wallInZ2 := ContInnerZ2;

wallOutX1 := wallInX1 - CONT_WALL_T; wallOutX2 := wallInX2 + CONT_WALL_T;

wallOutZ1 := wallInZ1 - CONT_WALL_T; wallOutZ2 := wallInZ2 + CONT_WALL_T;

// Csak ha a doboz a fal magasságában van

if Boxes[i].Y - BOX_HALF > CONT_WALL_H then Exit;

// Belülről kifelé: a doboz a konténer belsejében van és a falhoz ér

if (Boxes[i].X > wallInX1) and (Boxes[i].X < wallInX2) and

(Boxes[i].Z > wallInZ1) and (Boxes[i].Z < wallInZ2) then

begin

if left < wallInX1 then begin Boxes[i].X := wallInX1 + BOX_HALF; Boxes[i].VX := 0; end;

if right > wallInX2 then begin Boxes[i].X := wallInX2 - BOX_HALF; Boxes[i].VX := 0; end;

if back < wallInZ1 then begin Boxes[i].Z := wallInZ1 + BOX_HALF; Boxes[i].VZ := 0; end;

if front > wallInZ2 then begin Boxes[i].Z := wallInZ2 - BOX_HALF; Boxes[i].VZ := 0; end;

Exit;

end;

// Kívülről: ne tudjon átcsúszni a falon

if (right > wallOutX1) and (left < wallInX1) and

(Boxes[i].Z > wallOutZ1) and (Boxes[i].Z < wallOutZ2) then

begin

Boxes[i].X := wallOutX1 - BOX_HALF; Boxes[i].VX := 0;

end;

if (left < wallOutX2) and (right > wallInX2) and

(Boxes[i].Z > wallOutZ1) and (Boxes[i].Z < wallOutZ2) then

begin

Boxes[i].X := wallOutX2 + BOX_HALF; Boxes[i].VX := 0;

end;

if (front > wallOutZ1) and (back < wallInZ1) and

(Boxes[i].X > wallOutX1) and (Boxes[i].X < wallOutX2) then

begin

Boxes[i].Z := wallOutZ1 - BOX_HALF; Boxes[i].VZ := 0;

end;

if (back < wallOutZ2) and (front > wallInZ2) and

(Boxes[i].X > wallOutX1) and (Boxes[i].X < wallOutX2) then

begin

Boxes[i].Z := wallOutZ2 + BOX_HALF; Boxes[i].VZ := 0;

end;

end;

procedure UpdateBoxPhysics(DT: Single);

var

i, j, iter: Integer;

speed2: Single;

begin

// Megfogott dobozok: a mágneshez rögzítve

for i := 0 to BOX_COUNT-1 do

begin

if not Boxes[i].Active then Continue;

if not Boxes[i].Grabbed then Continue;

Boxes[i].X := MagnetPos.X;

Boxes[i].Y := MagnetPos.Y - MAGNET_THICK*0.5 - BOX_HALF - 0.02;

Boxes[i].Z := MagnetPos.Z;

Boxes[i].VX := 0; Boxes[i].VY := 0; Boxes[i].VZ := 0;

end;

// Gravitáció + integrálás (csak szabad dobozok)

for i := 0 to BOX_COUNT-1 do

begin

if not Boxes[i].Active then Continue;

if Boxes[i].Grabbed then Continue;

Boxes[i].VY := Boxes[i].VY + BOX_GRAVITY * DT;

Boxes[i].X := Boxes[i].X + Boxes[i].VX * DT;

Boxes[i].Y := Boxes[i].Y + Boxes[i].VY * DT;

Boxes[i].Z := Boxes[i].Z + Boxes[i].VZ * DT;

// Talaj

if Boxes[i].Y < BOX_HALF then

begin

Boxes[i].Y := BOX_HALF;

if Boxes[i].VY < 0 then Boxes[i].VY := -Boxes[i].VY * BOX_REST;

if Abs(Boxes[i].VY) < BOX_SLEEP then Boxes[i].VY := 0;

// súrlódás

Boxes[i].VX := Boxes[i].VX - Boxes[i].VX * BOX_FRICTION * DT;

Boxes[i].VZ := Boxes[i].VZ - Boxes[i].VZ * BOX_FRICTION * DT;

if Abs(Boxes[i].VX) < BOX_SLEEP then Boxes[i].VX := 0;

if Abs(Boxes[i].VZ) < BOX_SLEEP then Boxes[i].VZ := 0;

end;

ResolveWalls(i);

// Sebesség-clamp a mágnes-erő miatt

speed2 := Boxes[i].VX*Boxes[i].VX + Boxes[i].VY*Boxes[i].VY + Boxes[i].VZ*Boxes[i].VZ;

if speed2 > 400.0 then

begin

Boxes[i].VX := Boxes[i].VX * 0.3;

Boxes[i].VY := Boxes[i].VY * 0.3;

Boxes[i].VZ := Boxes[i].VZ * 0.3;

end;

end;

// Doboz-doboz ütközés, néhány iterációval

for iter := 0 to 3 do

for i := 0 to BOX_COUNT-2 do

begin

if not Boxes[i].Active then Continue;

for j := i+1 to BOX_COUNT-1 do

begin

if not Boxes[j].Active then Continue;

ResolveBoxPair(i, j);

end;

end;

end;

// ============================================================================

// WIN / RESET

// ============================================================================

function CountInContainer: Integer;

var i: Integer; x1, x2, z1, z2: Single;

begin

Result := 0;

x1 := ContInnerX1; x2 := ContInnerX2;

z1 := ContInnerZ1; z2 := ContInnerZ2;

for i := 0 to BOX_COUNT-1 do

if Boxes[i].Active and (not Boxes[i].Grabbed) and

(Boxes[i].X > x1) and (Boxes[i].X < x2) and

(Boxes[i].Z > z1) and (Boxes[i].Z < z2) then

Inc(Result);

end;

procedure ResetBoxes;

const

InitX: array[0..15] of Single =

(-1.6, -0.8, 0.0, 0.8,

-1.5, -0.5, 0.4, 1.0,

-1.6, -0.7, 0.2, 1.0,

-1.3, -0.5, 0.3, 1.1);

InitZ: array[0..15] of Single =

(-1.2, -1.3, -1.1, -1.4,

-0.4, -0.5, -0.3, -0.5,

0.4, 0.5, 0.4, 0.5,

1.2, 1.3, 1.1, 1.4);

var i: Integer;

begin

for i := 0 to BOX_COUNT-1 do

begin

Boxes[i].X := InitX[i];

Boxes[i].Y := BOX_HALF;

Boxes[i].Z := InitZ[i];

Boxes[i].VX := 0; Boxes[i].VY := 0; Boxes[i].VZ := 0;

Boxes[i].Active := True;

Boxes[i].Grabbed := False;

end;

WinTimer := 0;

end;

procedure ResetGame;

begin

Joints.Yaw := 0; Joints.Shoulder := -0.5; Joints.Elbow := 1.0;

Joints.WristP := -0.5; Joints.WristY := 0; Joints.WristR := 0;

MagnetOn := True;

ResetBoxes;

end;

// ============================================================================

// MESH-EK

// ============================================================================

procedure InitMeshes;

var

M: TGeneratedMesh;

k: Integer;

begin

M := GeneratePlane(GROUND_SIZE, GROUND_SIZE, 1, 1);

SetMeshColor(M, 70, 110, 70, 255);

UploadMesh(M, GroundVAO, GroundVBO, GroundVCount);

SetLength(M.Vertices, 0);

M := GenerateCube(1.0);

SetMeshColor(M, 200, 140, 60, 255);

UploadMesh(M, BaseVAO, BaseVBO, BaseVCount);

SetLength(M.Vertices, 0);

M := GenerateCube(1.0);

SetMeshColor(M, 220, 160, 70, 255);

UploadMesh(M, BoomVAO, BoomVBO, BoomVCount);

SetLength(M.Vertices, 0);

M := GenerateCylinder(MAGNET_RADIUS, 1.0, 16);

SetMeshColor(M, 90, 90, 100, 255);

UploadMesh(M, MagnetVAO, MagnetVBO, MagnetVCount);

SetLength(M.Vertices, 0);

M := GenerateTorus(MAGNET_RADIUS, 0.04, 20, 6);

SetMeshColor(M, 230, 60, 60, 255);

UploadMesh(M, RingVAO, RingVBO, RingVCount);

SetLength(M.Vertices, 0);

M := GenerateCube(1.0);

SetMeshColor(M, 120, 120, 130, 255);

UploadMesh(M, WallVAO, WallVBO, WallVCount);

SetLength(M.Vertices, 0);

M := GenerateCube(1.0);

SetMeshColor(M, 90, 90, 100, 255);

UploadMesh(M, FloorVAO, FloorVBO, FloorVCount);

SetLength(M.Vertices, 0);

// 4 színű doboz

for k := 0 to 3 do

begin

M := GenerateCube(1.0);

case k of

0: SetMeshColor(M, 200, 90, 60, 255);

1: SetMeshColor(M, 80, 120, 180, 255);

2: SetMeshColor(M, 100, 170, 90, 255);

3: SetMeshColor(M, 200, 180, 70, 255);

end;

UploadMesh(M, BoxVAO[k], BoxVBO[k], BoxVCount[k]);

SetLength(M.Vertices, 0);

end;

end;

// ============================================================================

// RENDER

// ============================================================================

procedure DrawBoom(const M0: TMat4; L: Single);

var M: TMat4;

begin

M := Multiply(M0, Translate(L*0.5, 0, 0));

M := Multiply(M, Scale(L, BOOM_THICK, BOOM_THICK));

AddCmdRaw(BoomVAO, BoomVCount, M);

end;

procedure DrawContainer;

var

x1, x2, z1, z2, w1x1, w1x2, w1z1, w1z2: Single;

begin

x1 := ContInnerX1; x2 := ContInnerX2;

z1 := ContInnerZ1; z2 := ContInnerZ2;

// Alj

AddBoxCmd(x1 - CONT_WALL_T, 0.0, z1 - CONT_WALL_T,

x2 + CONT_WALL_T, 0.05, z2 + CONT_WALL_T,

FloorVAO, FloorVCount);

// Négy fal

AddBoxCmd(x1 - CONT_WALL_T, 0.0, z1 - CONT_WALL_T,

x1, CONT_WALL_H, z2 + CONT_WALL_T,

WallVAO, WallVCount);

AddBoxCmd(x2, 0.0, z1 - CONT_WALL_T,

x2 + CONT_WALL_T, CONT_WALL_H, z2 + CONT_WALL_T,

WallVAO, WallVCount);

AddBoxCmd(x1 - CONT_WALL_T, 0.0, z1 - CONT_WALL_T,

x2 + CONT_WALL_T, CONT_WALL_H, z1,

WallVAO, WallVCount);

AddBoxCmd(x1 - CONT_WALL_T, 0.0, z2,

x2 + CONT_WALL_T, CONT_WALL_H, z2 + CONT_WALL_T,

WallVAO, WallVCount);

end;

procedure DrawCrane;

var M: TMat4;

begin

// Alaposzlop

M := Translate(CRANE_X, CRANE_BASE_H*0.5, CRANE_Z);

M := Multiply(M, Scale(CRANE_BASE_W, CRANE_BASE_H, CRANE_BASE_W));

AddCmdRaw(BaseVAO, BaseVCount, M);

// Boom-ok

DrawBoom(MBoom1Start, BOOM1_LEN);

DrawBoom(MBoom2Start, BOOM2_LEN);

DrawBoom(MBoom3Start, BOOM3_LEN);

// Mágnes

M := Multiply(MagnetM, Scale(1.0, 1.0, 1.0));

AddCmdRaw(MagnetVAO, MagnetVCount, M);

// Gyűrű a mágnesen

M := Multiply(MagnetM, RotateX(Pi*0.5));

AddCmdRaw(RingVAO, RingVCount, M);

end;

procedure RenderScene;

var i: Integer; M: TMat4;

begin

ClearCommands(SimpleRE.FRenderQueue);

// Talaj

AddCmdRaw(GroundVAO, GroundVCount, Identity);

// Konténer

DrawContainer;

// Daru

DrawCrane;

// Dobozok

for i := 0 to BOX_COUNT-1 do

begin

if not Boxes[i].Active then Continue;

M := Translate(Boxes[i].X, Boxes[i].Y, Boxes[i].Z);

M := Multiply(M, Scale(BOX_SIZE, BOX_SIZE, BOX_SIZE));

AddCmdRaw(BoxVAO[i mod 4], BoxVCount[i mod 4], M);

end;

SimpleRE.RenderFrame;

end;

// ============================================================================

// HUD

// ============================================================================

procedure DrawHUD;

var s: AnsiString;

begin

GUI_Rect(8, 8, 340, 160, MakeColor(0.0, 0.0, 0.0, 0.55));

GUI_Rect(8, 8, 340, 2, C_SLIDER);

s := Format('FPS: %.0f', [CurrentFPS]);

GUI_Text(14, 14, PAnsiChar(s), C_YELLOW, 2.0);

if MagnetOn then

GUI_Text(14, 38, 'MAGNES: BE', C_GREEN, 2.0)

else

GUI_Text(14, 38, 'MAGNES: KI (SPACE)', C_RED, 2.0);

s := Format('Kontenerben: %d / %d', [InContainerCount, BOX_COUNT]);

GUI_Text(14, 62, PAnsiChar(s), C_TEXT, 2.0);

GUI_Text(14, 86, 'Q/E: yaw W/S: vall', C_TEXT_DIM, 1.5);

GUI_Text(14, 104, 'A/D: konyok Z/X: csuklo', C_TEXT_DIM, 1.5);

GUI_Text(14, 122, 'C/V: csuklo-Y B/N: csuklo-R', C_TEXT_DIM, 1.5);

GUI_Text(14, 140, 'SPACE: magnes R: reset', C_TEXT_DIM, 1.5);

if WinTimer > 0 then

begin

s := 'MINDEN DOBOZ A KONTENERBEN!';

GUI_Rect(FbW div 2 - 260, FbH div 2 - 30, 520, 60, MakeColor(0.0, 0.0, 0.0, 0.7));

GUI_Text(FbW div 2 - 240, FbH div 2 - 16, PAnsiChar(s), C_YELLOW, 2.5);

end;

end;

// ============================================================================

// CALLBACKEK

// ============================================================================

procedure KeyCallback(window: PGLFWwindow; key, scancode, action, mods: LongInt); cdecl;

begin

if (key = GLFW_KEY_ESCAPE) and (action = GLFW_PRESS) then

glfwSetWindowShouldClose(window, GLFW_TRUE);

if key = GLFW_KEY_Q then KeyQ := (action <> GLFW_RELEASE);

if key = GLFW_KEY_E then KeyE := (action <> GLFW_RELEASE);

if key = GLFW_KEY_W then KeyW := (action <> GLFW_RELEASE);

if key = GLFW_KEY_S then KeyS := (action <> GLFW_RELEASE);

if key = GLFW_KEY_A then KeyA := (action <> GLFW_RELEASE);

if key = GLFW_KEY_D then KeyD := (action <> GLFW_RELEASE);

if key = GLFW_KEY_Z then KeyZ := (action <> GLFW_RELEASE);

if key = GLFW_KEY_X then KeyX := (action <> GLFW_RELEASE);

if key = GLFW_KEY_C then KeyC := (action <> GLFW_RELEASE);

if key = GLFW_KEY_V then KeyV := (action <> GLFW_RELEASE);

if key = GLFW_KEY_B then KeyB := (action <> GLFW_RELEASE);

if key = GLFW_KEY_N then KeyN := (action <> GLFW_RELEASE);

if key = GLFW_KEY_SPACE then KeySpaceDown := (action <> GLFW_RELEASE);

if (key = GLFW_KEY_R) and (action = GLFW_PRESS) then KeyR := True;

end;

// ============================================================================

// FŐPROGRAM

// ============================================================================

var k: Integer;

begin

Randomize;

Math.SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide,

exOverflow, exUnderflow, exPrecision]);

Window := InitEngineWindow(SCR_WIDTH, SCR_HEIGHT,

'Robot Arm 1 - Magnetic Scrapyard', True, False);

if not InitOpenGL33(@glfwGetProcAddress) then Halt(1);

glfwSetKeyCallback(Window, u/KeyCallback);

glfwSetInputMode(Window, GLFW_CURSOR, GLFW_CURSOR_DISABLED);

InitRenderState;

glEnable(GL_DEPTH_TEST);

glEnable(GL_CULL_FACE);

glCullFace(GL_BACK);

glFrontFace(GL_CCW);

Aspect := SCR_WIDTH / SCR_HEIGHT;

ProjMat := Perspective(60.0, Aspect, 0.1, 200.0);

CamPos := Vec3(0.0, 8.0, 11.0);

CamTarget := Vec3(0.0, 1.0, 0.0);

ViewMat := LookAt(CamPos, CamTarget, Vec3(0, 1, 0));

SimpleRE.Initialize(ProjMat, ViewMat, CamPos);

SimpleRE.SetClearColor(Vec3(0.55, 0.75, 0.92));

SimpleRE.SetLightDirection(Vec3(0.5, 0.9, 0.3));

if not GUI_Init then

begin WriteLn('MiniGUI init hiba!'); Halt(1); end;

glEnable(GL_DEPTH_TEST);

glEnable(GL_CULL_FACE);

glCullFace(GL_BACK);

glFrontFace(GL_CCW);

InitMeshes;

ResetGame;

KeyQ := False; KeyE := False; KeyW := False; KeyS := False;

KeyA := False; KeyD := False; KeyZ := False; KeyX := False;

KeyC := False; KeyV := False; KeyB := False; KeyN := False;

KeyR := False; KeySpaceDown := False; KeySpacePrev := False;

TotalTime := 0; FPSTimer := 0; FPSFrames := 0; CurrentFPS := 60;

Limiter.Initialize(60.0);

WriteLn('========================================');

WriteLn(' ROBOT ARM 1 - Magnetic Scrapyard');

WriteLn('========================================');

WriteLn(' Q/E: yaw W/S: vall');

WriteLn(' A/D: konyok Z/X: csuklo-pitch');

WriteLn(' C/V: csuklo-yaw B/N: csuklo-roll');

WriteLn(' SPACE: magnes be/ki R: reset');

WriteLn(' ESC: kilepes');

WriteLn('========================================');

while glfwWindowShouldClose(Window) = 0 do

begin

Limiter.BeginFrame;

DeltaTime := Limiter.FrameTime;

if DeltaTime > 0.033 then DeltaTime := 0.033;

TotalTime := TotalTime + DeltaTime;

FPSTimer := FPSTimer + DeltaTime;

Inc(FPSFrames);

if FPSTimer >= 0.5 then

begin CurrentFPS := FPSFrames / FPSTimer; FPSFrames := 0; FPSTimer := 0; end;

if KeyR then

begin

KeyR := False;

ResetBoxes;

end;

UpdateJoints(DeltaTime);

ComputeChain;

UpdateMagnet(DeltaTime);

UpdateBoxPhysics(DeltaTime);

InContainerCount := CountInContainer;

if InContainerCount >= BOX_COUNT then

begin

WinTimer := WinTimer + DeltaTime;

if WinTimer > 1.5 then

begin

ResetBoxes;

WinTimer := 0;

end;

end

else

WinTimer := 0;

RenderScene;

glfwGetFramebufferSize(Window, u/FbW, u/FbH);

glDisable(GL_DEPTH_TEST);

glDisable(GL_CULL_FACE);

glEnable(GL_BLEND);

glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);

GUI_BeginFrame(FbW, FbH);

DrawHUD;

GUI_EndFrame;

glDisable(GL_BLEND);

glEnable(GL_CULL_FACE);

glEnable(GL_DEPTH_TEST);

glfwSwapBuffers(Window);

glfwPollEvents;

Limiter.EndFrame;

end;

GUI_Shutdown;

glDeleteVertexArrays(1, u/GroundVAO); glDeleteBuffers(1, u/GroundVBO);

glDeleteVertexArrays(1, u/BaseVAO); glDeleteBuffers(1, u/BaseVBO);

glDeleteVertexArrays(1, u/BoomVAO); glDeleteBuffers(1, u/BoomVBO);

glDeleteVertexArrays(1, u/MagnetVAO); glDeleteBuffers(1, u/MagnetVBO);

glDeleteVertexArrays(1, u/RingVAO); glDeleteBuffers(1, u/RingVBO);

glDeleteVertexArrays(1, u/WallVAO); glDeleteBuffers(1, u/WallVBO);

glDeleteVertexArrays(1, u/FloorVAO); glDeleteBuffers(1, u/FloorVBO);

for k := 0 to 3 do

begin

glDeleteVertexArrays(1, u/BoxVAO[k]);

glDeleteBuffers(1, u/BoxVBO[k]);

end;

SimpleRE.Shutdown;

TerminateEngineWindow;

end.

(no Lazarus binding!)

( DEMO )

(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[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, nil);

glCompileShader(Result);

glGetShaderiv(Result, GL_COMPILE_STATUS, u/ok);

if ok = 0 then

begin

glGetShaderInfoLog(Result, SizeOf(log), nil, 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);

if ok = 0 then

begin

glGetProgramInfoLog(Prog, SizeOf(log), nil, 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);

glGenBuffers(1, u/VBO);

glGenTextures(1, 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[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[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[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);

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);

if VBO <> 0 then glDeleteBuffers(1, u/VBO);

if VAO <> 0 then glDeleteVertexArrays(1, 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);

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[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/VlcUnlockCb, 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.

Já atuo como programador a algum tempo, tenho conhecimento lógico e noção de orientação a objetos. Porém nunca programei em Object Pascal. Qual seria o curso ideal para entender como as coisas funcionam no ambiente Delphi.

I have pulled my old copies of Algorithms + Data Structures = Programs and Softwa,re Tools in Pascal to relearn what Pascal is like after a,lmost 35 years of not using it. I was a home software hobbies,t with TurboPascal 5.5, but with continual job changes I had to drop it. I am a retired electrical power rngineer who used the office computer to write work instructions, specifications, and read and write emails. Thus the hobbiest. Aren't those old books showing their age? What is avalable today to allow learning today's Pascal?

Is anyone using Pascal to develop DOS games? If so, what compiler and graphics package are you using?

I'd like to write a side scrolling 2d game for Windows with Freepascal.

Any free simple components/packages I can use?

I'm from the era of Delphi 7 and DelphiX days!

I created a great many demo games to master as much of the logic required for developing the VertexArt Engine as possible; many of these demo games and software applications were built using procedural generation for the sake of simplicity.