VertexArt – successful implementation of a pure Free Pascal FLAC encoder and WAV export in my procedural music editor.
▲ 13 r/pascal

VertexArt – successful implementation of a pure Free Pascal FLAC encoder and WAV export in my procedural music editor.

# 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**.

u/AcanthaceaeNew774 — 12 days ago
▲ 9 r/pascal

6dof robot arm - Free Pascal 3.2.2 / GLFW3 / OpenGL 3.3 / DOD / MiniGUI.pas / own wrappers

// 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.

u/AcanthaceaeNew774 — 15 days ago
▲ 4 r/pascal

VertexArt – lightning-fast development in moments! (For now, I’m showcasing the demo projects through images.)

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.

u/AcanthaceaeNew774 — 23 days ago
▲ 23 r/pascal

VertexArt - Vehicle &amp; Trailer

Car 3D – Procedural terrain and vehicle physics in Free Pascal, without external physics libraries.

What you see in the video:

Analytical terrain: two hills and a valley; the elevation is calculable at any point

Four wheels: the front two steer, and all four roll and follow the terrain

Spring-damper suspension acting on three axes (vertical displacement, pitch, and roll)

Slope detection: the car holds its position on a gentle slope but rolls away on a steep one

Handbrake (P key) that holds the car in place anywhere

Trailer with a kinematic hitch, causing it to cut corners

Steering mechanism located on top of the chassis

Technical details:

Slope detection uses the numerical gradient of the terrain's elevation function

Wheel positions are calculated based on the chassis's local coordinates, with elevation determined via bilinear sampling

Suspension physics follow the formula F = k·(target − current) − c·velocity, with slight under-damping

The trailer uses a classic towed-body model: the axle maintains a fixed distance L from the hitch point

u/AcanthaceaeNew774 — 29 days ago
▲ 19 r/pascal

VertexArt - Billiards - fully procedural ( Logic demo )

Pure Free Pascal 3.2.2 / GLFW3 / OpenGL 3.3 / DOD

u/AcanthaceaeNew774 — 1 month ago
▲ 10 r/pascal

VertexArt - Tank &amp; Opponent (Logic demo)

Pure Free Pascal 3.2.2 / GLFW3 / OpenGL 3.3 / DOD

u/AcanthaceaeNew774 — 1 month ago
▲ 14 r/pascal

VertexArt - Maze 3D - AI navigation with collectible objects

# Maze3D - Játék Működésének Részletes Leírása

## 1. Labirintus Generálás

### Algoritmus: Rekurzív Backtracking

A labirintus generálása egy **41x41-es rácsban** történik, ahol a páratlan indexű cellák lesznek a folyosók, a páros indexűek pedig a falak.

#### Lépések:

  1. **Inicializálás**- Minden cella fal (`ctWall`) lesz- A start és cél koordináták páratlanra igazítása (hogy a folyosón legyenek)
  2. **Stack-alapú Bejárás**```Kezdőpont berakása a verembeAmíg a verem nem üres:

- Aktuális cella = verem teteje

- Szomszédok véletlenszerű sorrendbe rendezése

- Ha van látogatatlan szomszéd:

* Fal eltávolítása a két cella között

* Szomszéd cella üresre állítása

* Szomszéd berakása a verembe

- Különben:

* Visszalépés (veremből kivétel)

```

  1. **Garancia**

- Mindig létezik út a start és cél között

- A labirintusnak nincsenek elszigetelt területei

- Maximális folyosóhossz, minimális fal

### Példa Generálásra:

```

  1. Kezdő: (1,1) - üres
  2. Véletlen szomszéd: (3,1) - fal eltávolítva, üres
  3. Véletlen szomszéd: (3,3) - fal eltávolítva, üres
  4. ... folytatódik amíg minden cella bejárt

```

---

## 2. Zsákutcák és Gyűjthető Tárgyak

### Zsákutca Felismerés

**Definíció:** Olyan üres cella, amelynek pontosan **3 fala** van (csak egy irányba lehet továbbmenni).

```pascal

// Ellenőrzés minden cellára

wallCount := 0;

if Grid[x-1, z] = ctWall then Inc(wallCount); // bal

if Grid[x+1, z] = ctWall then Inc(wallCount); // jobb

if Grid[x, z-1] = ctWall then Inc(wallCount); // fel

if Grid[x, z+1] = ctWall then Inc(wallCount); // le

if wallCount = 3 then // ZSÁKUTCA!

```

**Kizárások:**

- Start pozíció (zöld padló)

- Cél pozíció (sárga padló)

### Tárgyak Elhelyezése

Minden zsákutcába **egy arany kocka** kerül:

  1. **Megjelenés:** Arany színű, forgó, ugráló kocka
  2. **Méret:** 0.3 egység (a játékos 0.6 egység)
  3. **Állapotok:** `csActive` (aktív) / `csCollected` (összegyűjtve)
  4. **Animáció:**- Folyamatos forgás az Y tengely körül- Apró ugráló mozgás (szinusz hullám)

### Tárgyak Száma

- **Tipikus:** 5-15 darab

- **Maximum:** ~400 (elméleti, de ritka)

- **Függ:** A labirintus struktúrájától

---

## 3. Navigáció és Útvonaltervezés

### A* Algoritmus

Az AI az **A\*** algoritmust használja az útvonaltervezéshez.

#### Működése:

```pascal

F = G + H

G = lépések száma a starttól

H = Manhattan távolság a célig (becslés)

F = teljes becsült költség

```

**Lépések:**

  1. **Nyílt lista:** A még vizsgálandó cellák
  2. **Zárt lista:** A már vizsgált cellák
  3. **Prioritás:** A legalacsonyabb F értékű cella kerül először vizsgálatra
  4. **Visszakövetés:** Amikor a cél megtalálható, visszafelé követjük a szülőket

#### Heurisztika:

```pascal

H = |x - goalX| + |z - goalZ| // Manhattan távolság

```

- **Előny:** Gyors, mindig optimális

- **Hátrány:** Nem veszi figyelembe a falakat (de az algoritmus kezeli)

### Útvonal Tárolása

Fix méretű tömbökben tároljuk az útvonalat:

```pascal

TPathArray = array[0..MAX_PATH_LENGTH-1] of TPoint;

PathLength: Integer; // Tényleges hossz

```

---

## 4. AI Viselkedés

### AI Állapotai

```

[Inaktív] → [Aktív - Gyűjtés] → [Aktív - Cél] → [Befejezve]

```

### Fázisok

#### 1. Indítás (StartAI)

```

  1. Aktív tárgyak listájának összeállítása
  2. Ha nincs tárgy:→ Közvetlen útvonal a célhoz
  3. Ha van tárgy:→ Legközelebbi tárgy keresése (A*-al)→ Útvonal tervezése oda
  4. Mozgás indítása

```

#### 2. Gyűjtési Fázis (UpdateAI)

```

Minden lépésnél:

  1. Ha célpozíción van:a. Ellenőrzi, van-e ott tárgyb. Ha van: felveszi (csCollected)c. Eltávolítja a gyűjtendők listájábóld. Megkeresi a következő legközelebbi tárgyate. Áttervezi az útvonalat
  2. Különben:→ Követi az aktuális útvonalat
  3. Ha nincs több tárgy:→ Átvált Cél fázisba

```

#### 3. Cél Fázis

```

  1. Útvonal tervezése a célhoz
  2. Követi az útvonalat
  3. Cél elérésekor:- új labirintus generálás

### Legközelebbi Tárgy Keresése

```pascal

function FindNearestCollectibleByPath(fromX, fromZ: Integer): Integer;

begin

Best := -1;

BestLen := MAXINT;

for i := 0 to TotalCollectibles-1 do

if Collectibles[i].State = csActive then

begin

// A* futtatása minden aktív tárgyra

if AStar(fromX, fromZ, Collectibles[i].X, Collectibles[i].Z, Path, Len) then

if Len < BestLen then

begin

BestLen := Len;

Best := i;

end;

end;

Result := Best;

end;

```

### AI Sebesség

- **AI.Speed := MOVE_SPEED * 0.8`

---

## 5. Játékos Mozgás

### Irányítás

- **Billentyűk:** W/A/S/D vagy nyilak

- **Csak 4 irány:** Előre, hátra, balra, jobbra

- **Nincs átlós mozgás** (a labirintus rács miatt)

### Mozgás Animáció

```pascal

  1. Billentyű lenyomása
  2. Cél cella ellenőrzése (járható-e?)
  3. Ha igen:- MoveProgress = 0- Moving = True
  4. Minden frame:- MoveProgress += Sebesség * DeltaTime- Interpoláció a két cella között
  5. Ha MoveProgress >= 1.0:- Célba érkezés- Tárgy ellenőrzés- Moving = False

```

### Tárgy Felvétel

```pascal

// Minden lépés után

for i := 0 to TotalCollectibles-1 do

if (Collectibles[i].State = csActive) and

(Collectibles[i].X = Player.GridX) and

(Collectibles[i].Z = Player.GridZ) then

begin

Collectibles[i].State := csCollected;

Inc(CollectiblesCollected);

// Visszajelzés

end;

```

---

## 6. Győzelmi Feltételek

### Játékos Győzelme

```

  1. Eléri a cél pozíciót (sárga padló)
  2. GameState = gsWin

```

### AI Győzelme

```

  1. Eléri a cél pozíciót
  2. GameState = gsWin
  3. Tárgy statisztika:- "Összegyűjtött tárgyak: X/Y"- Ha X=Y: Célba csak akkor ér, ha MINDEN TÁRGYAT ÖSSZEGYŰJTÖTT!"

```

### Új Játék

- `ENTER` vagy `SPACE` lenyomása a győzelmi képernyőn

- Új labirintus generálása

- Új tárgyak elhelyezése

- Mindenki vissza a start pozícióba

---

## 7. Adatstruktúrák Összefoglalása

### Fix Méretű Tömbök

| Adat | Típus | Maximális Méret | Számláló |

|------|-------|-----------------|----------|

| DeadEnds | array[0..499] of TPoint | 500 | DeadEndCount |

| Collectibles | array[0..499] of TCollectible | 500 | TotalCollectibles |

| AI.Path | array[0..1999] of TPoint | 2000 | PathLength |

| AI.Remaining | array[0..499] of TPoint | 500 | CollectiblesRemainingCount |

| Stack | array[0..1680] of record | 1681 | StackLen |

| OpenList | array[0..1680] of Integer | 1681 | OpenCount |

### Rekordok

```pascal

TPlayer = record

GridX, GridZ: Integer; // Rács pozíció

X, Z: Single; // Valós pozíció

Moving: Boolean; // Mozgás állapota

MoveProgress: Single; // Animáció (0-1)

FacingAngle: Single; // Nézési irány

end;

TAIState = record

Active: Boolean; // Fut-e

Path: TPathArray; // Útvonal

PathIndex: Integer; // Pozíció az útvonalban

GridX, GridZ: Integer; // Rács pozíció

Collecting: Boolean; // Gyűjtési fázis?

CollectiblesRemainingCount: Integer; // Hátralévő tárgyak

end;

```

---

## 8. Jellemzők

- Nincs dinamikus memóriafoglalás

- Cache-barát adatelrendezés

- Fix 60 FPS limit

u/AcanthaceaeNew774 — 1 month ago
▲ 24 r/pascal

VertexArt - Bomberman 3D Demo ( ply versio )

Pure Free Pascal 3.2.2 / GLFW3 / OpenGL 3.3 / DOD

u/AcanthaceaeNew774 — 1 month ago
▲ 16 r/pascal+1 crossposts

VertexArt - Tetris

1. Nincs dinamikus memória, nincsenek osztályok

A legtöbb Tetris implementáció objektumorientált, és dinamikusan allokálja a darabokat, a táblát vagy a részecskéket. Ez a verzió fix méretű tömböket használ mindenre, és procedurális felépítésű.

pascal

// A teljes játékállapot fix tömbben:
Board: array[0..COLS-1, 0..ROWS-1] of Byte;
Tetrominoes: array[0..6, 0..3, 0..3, 0..3] of Byte;

Előny: Kiszámítható memóriahasználat, nincs fragmentáció, gyors és biztonságos.

2. Interpolált mozgás a darabok között

A legtöbb Tetrisben a darabok ugrálnak celláról cellára. Itt a Lerp (lineáris interpoláció) simává teszi a mozgást.

pascal

function GetInterpolatedX: Single;
begin
if ActivePiece.IsMoving then
Result := ActivePiece.PrevX + (ActivePiece.X - ActivePiece.PrevX) * ActivePiece.Lerp
else
Result := ActivePiece.X;
end;

3. Előre definiált maszkok – nincs futásidőbeli forgatás

A legtöbb Tetrisben a darabokat matematikailag forgatják (mátrix transzformáció). Itt mind a 4 forgás előre definiálva van mind a 7 darabhoz.

pascal

// Példa: L alakzat összes forgása előre megadva
Tetrominoes[TYPE_L, 0, 1, 2] := 1; // 0. forgás
Tetrominoes[TYPE_L, 1, 1, 1] := 1; // 1. forgás
// stb.

Előny: Gyorsabb, egyszerűbb, és garantáltan pontos az ütközésvizsgálat.

u/AcanthaceaeNew774 — 1 month ago
▲ 17 r/pascal

VertexArt - Space Invaders - Tech Demo

Játék állapotai:

  1. Menü - Főmenü, ahol indíthatod vagy kiléphetsz a játékból
  2. Játék - Aktív játékmenet
  3. Game Over - Játék vége állapot (vereség vagy győzelem)

⌨️ Irányítás

Menüben:

  • ← / → - Menüpontok közötti váltás
  • ENTER - Kiválasztás

Játékban:

Billentyű |Funkció
Egér |Hajó mozgatása
SZÓKÖZ |Rakéta kilövése
R |Játék újraindítása
P |Szünet / Folytatás
ESC |Vissza a menübe ⚙️** Játékmechanik**ák

1. 🚀 Lövedékrendszer

  • A játékos 3 csövű ágyúval rendelkezik
  • Lövedékek sebessége: 12.0 egység/másodperc
  • Lövési sebesség: 0.1 másodperc
  • A lövedékek

 

cián

  • színűek és 0.08 egység méretűek

2. 💥 Rakétarendszer

  • Aktiválás: SZÓKÖZ billentyű
  • Sebesség: 5.0 egység/másodperc
  • Robbanási sugár: 4.0 egység
  • Sebzés: 3 életpont
  • Lökőerő: 5.0 egység
  • Gyújtóidő: 0.5 másodperc (érintéskor)
  • A rakéta automatikusan felrobban, ha ellenséget érzékel

3. 🎆 Részecskerendszer

  • Max részecskék: 2000
  • Gravitáció: -9.8 m/s²
  • Típusok:
    • Robbanás részecskék: Sárga színűek
    • Nyomvonal részecskék: Sárga színűek
    • Tűzijáték részecskék: Sárga színűek

4. 🎇 Tűzijáték rendszer

  • Max tűzijátékok: 5
  • Részecskék/tűzijáték: 100
  • Élettartam: 2.5 másodperc
  • Időköz: 0.3-1.5 másodperc
  • Csak győzelem esetén aktiválódik

👾 Ellenségek viselkedése

Alap tulajdonságok:

  • Életerő: 9 HP (boostolt állapotban 18)
  • Méret: 0.9 x 0.5 x 0.9 egység
  • Lövési időköz: 2.5-4.5 másodperc
  • Lövedék sebessége: 4.0 egység/másodperc

Viselkedési minták:

1. 🏃 Dodge (Kitérés)

  • Reagál a játékos lövedékeire
  • Érzékelési sugár: 2.5 egység
  • Kitérési sebesség: 4.0
  • Fal elkerülés: Automatikus visszafordulás a falaktól

2. 📉 Menekülési mód (Boost)

  • Aktiválódás: Amikor 10 vagy kevesebb ellenség marad
  • Tulajdonságok:
    • Életerő megduplázódik (18 HP)
    • Gyorsabb lövés (1.0-1.3 másodperc)

3. 💨 Visszatérés a rácsba

  • Rakéta robbanás után aktiválódik
  • Sebesség: 0.5-1.3 (véletlenszerű)
  • Közben dőlés a mozgás irányába

4. ☠️ Halál animáció

  • Zuhanás sebessége: 2.5 egység/másodperc
  • Forgás: Véletlenszerű (20-60 fok/másodperc)
  • Nyomvonal: Sárga részecskék
  • Eltűnés: -20.0 egységnél

Ellenségek szétválasztása

  • Erő: 2.5
  • Távolság: 1.2 egység
  • Megakadályozza az ellenségek egymásba olvadását
u/AcanthaceaeNew774 — 2 months ago
▲ 28 r/pascal

VertexArt - Space Invaders Demo - almost finished Tech Demo

Free Pascal 3.2.2 / GLFW3 / OpenGL 3.3 / DOD / Intel N4100 ( runs on one CPU core )

u/AcanthaceaeNew774 — 2 months ago
▲ 11 r/pascal

VertexArt - Wallbreaker - with fluorescent ball - some Tetris logic in the use of boxes

Breakout 3D Dokumentáció

================================================================================

A program egy 3D-s Breakout játék, amelyet Free Pascal 3.2.2, GLFW3 és OpenGL
3.3 felhasználásával készítettem. A játék különlegessége, hogy a téglák emeletes
elrendezésben helyezkednek el, és Tetris-szerűen esnek lefelé,
ha az alattuk lévő téglák eltűnnek.

================================================================================

2. FELHASZNÁLT MODULOK

SysUtils, Math

· Alacsony szintű segédprogramok, matematikai függvények

glfw3

· Ablakkezelés, billentyűzet/egér kezelés

gl33

· OpenGL 3.3 függvények

SterilTypes, SterilMath

· Saját típusok (TVector3, TMat4) és mátrix műveletek

SterilWindow

· Ablak inicializálás

FrameLimiter

· FPS korlátozás és időzítés

RenderTypes, RenderQueue, RenderState

· Renderelő parancsok, sor, állapotok

ShaderCore

· Shader programok

SimpleRenderEngine

· Fő renderelő motor

MeshGenerators

· 3D primitívek generálása

================================================================================

3. ÁLLAPOTGÉP

A játéknak három állapota van:

gsMenu

· Főmenü – START és EXIT gombok

gsPlaying

· A játék fut

gsQuit

· Kilépés a programból

A főállapot-változó: GameState: TGameState

================================================================================

4. ADATSZERKEZETEK

4.1. TBrick – Tégla

TBrick = record
Pos: TVector3; // pozíció a térben
Size: TVector3; // méret
Color: TVector3; // szín (RGB 0..1)
Active: Boolean; // létezik-e még
VAO, VBO: GLuint; // GPU azonosítók
VertexCount: Integer; // csúcsok száma
Mesh: TGeneratedMesh; // generált háló
GridX, GridY, GridZ: Integer; // pozíció a 3D rácsban
Falling: Boolean; // esik-e éppen
FallProgress: Single; // 0..1 esés állapota
FallStartZ, FallTargetZ: Integer;
FallStartPosY, FallTargetPosY: Single;
end;

4.2. TBall – Labda

TBall = record
Pos: TVector3;
Vel: TVector3;
Size: Single;
Color: TVector3;
Active: Boolean;
VAO, VBO: GLuint;
VertexCount: Integer;
Mesh: TGeneratedMesh;
end;

4.3. TPaddle – Ütő

TPaddle = record
Pos: TVector3;
Size: TVector3;
Color: TVector3;
VAO, VBO: GLuint;
VertexCount: Integer;
Mesh: TGeneratedMesh;
end;

================================================================================

5. JÁTÉKMECHANIKA

5.1. Téglák elrendezése (3D rács)

A téglák egy 3D rácsban helyezkednek el:

· GRID_SIZE_X = 10 – szélesség
· GRID_SIZE_Y = 10 – mélység
· GRID_SIZE_Z = 3 – magasság (szintek)

Egy tégla pozíciója a rácsban: (GridX, GridY, GridZ)

Térbeli pozíció számítás:
PosX := (GridX - (GRID_SIZE_X-1)/2) * BRICK_SPACING
PosY := GROUND_Y + 0.35 + GridZ * BRICK_SPACING
PosZ := 10.0 + (GridY - (GRID_SIZE_Y-1)/2) * BRICK_SPACING

5.2. Esés animáció (Tetris-stílus)

Ha egy téglát eltalál a labda, a felette lévő téglák (azonos GridX, GridY,
nagyobb GridZ) elindulnak lefelé. Az esés animált:
BRICK_FALL_SPEED = 2.0 szint/másodperc. A UpdateBrickFalls ciklus minden
frame-ben frissíti az eső téglák pozícióját.

5.3. Labda fizika

A labda vízszintes síkban (X-Z) mozog, Y pozíciója fix (GROUND_Y + Size).
Ütközés a falakkal, a paddle-el és a téglákkal. Pattanás: a téglákra a
legkisebb átfedés alapján pattan (X vagy Z irányban). Sebesség normalizálás:
a labda sebessége mindig BALL_SPEED.

5.4. Ütő (Paddle)

Mozgása: egér X irányú mozgása (vízszintes). A paddle csak X irányban
mozoghat (-5.0 és 5.0 között).

5.5. Kamera

A kamera az ütőt követi X irányban:
CamPos := Vec3(Paddle.Pos.X, 4.0, -4.0)
CamTarget := Vec3(Paddle.Pos.X, 0.5, 4.0)

================================================================================

6. BILLENTYŰKEZELÉS

ESC

· Játékból → menü, menüből → kilépés

← / →

· Menüben váltás a START és EXIT között

Enter

· Menüben választás

R

· Játék újraindítása

P

· Szünet / folytatás

Space

· Új játék Game Over után

================================================================================

7. RENDERELÉS

A renderelés a SimpleRenderEngine-en keresztül történik:

  1. Queue töltése: a téglák, labda és paddle TRenderCommand-jeit hozzáadjuk
  2. a SimpleRE.FRenderQueue-hoz.
  3. RenderFrame hívás: a motor végrehajtja a mélységpasszt, vonalpasszt

(ha van)

  1. és
  2. színpasszt.
  3. Pontfény: a labdára egy zöld pontfényt állítunk be (SetPointLight).

================================================================================

8. FŐSZERKEZET

Inicializálás:

· Ablak, OpenGL, SimpleRE
· Menü gombok létrehozása
· FrameLimiter indítása

Főciklus:
amíg az ablak nyitva:
DeltaTime számítása
case GameState of
gsMenu:
RenderMenu
gsPlaying:
UpdateBrickFalls
UpdatePaddle
UpdateBall
UpdateCamera
RenderGame
gsQuit:
kilépés
SwapBuffers
PollEvents
FPS kiírás

Leállítás:

· GPU erőforrások felszabadítása
· SimpleRE.Shutdown
· Ablak bezárása

================================================================================

9. KONSTANSOK ÉS HANGOLHATÓ PARAMÉTEREK

SCR_WIDTH = 1280

· Képernyő szélesség

SCR_HEIGHT = 720

· Képernyő magasság

GROUND_Y = -0.5

· Talaj szintje

BALL_SPEED = 6.0

· Labda sebessége

GRID_SIZE_X = 10

· Téglák száma X irányban

GRID_SIZE_Y = 10

· Téglák száma Y irányban

GRID_SIZE_Z = 3

· Téglák száma Z irányban (szintek)

BRICK_SPACING = 1.1

· Téglák közötti távolság

BRICK_FALL_SPEED = 2.0

· Esés sebessége (szint/másodperc)

PADDLE_WIDTH = 1.6

· Ütő szélessége

PADDLE_HEIGHT = 0.12

· Ütő magassága

PADDLE_DEPTH = 0.6

· Ütő mélysége

================================================================================

10. ÖSSZEGZÉS

A Breakout 3D - egy megbízható, jól strukturált 3D-s
játékmotor demo, amely bemutatja a VertexArt Arcade keretrendszer képességeit. A kód tiszta,
moduláris, és könnyen bővíthető új funkciókkal (pl. több pálya, nehezítés).

================================================================================

Fejlesztő: Kovács István

u/AcanthaceaeNew774 — 2 months ago